home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / SNNSV32.ZIP / SNNSv3.2 / kernel / sources / learn_f.c < prev    next >
C/C++ Source or Header  |  1994-04-25  |  197KB  |  6,131 lines
  1. /*****************************************************************************
  2.   FILE           : learn_f.c
  3.   SHORTNAME      : learn_f
  4.   SNNS VERSION   : 3.2
  5.  
  6.   PURPOSE        : SNNS-Kernel Learning Functions
  7.   NOTES          : with following learning functions:
  8.                - Backpropagation
  9.                - Backpropagation with momentum term
  10.                    - Quickprop
  11.                - Counterpropagation
  12.                - BackPercolation
  13.                    - Backpropagation through time
  14.                    - Batch backpropagation through time
  15.                    - Quickprop through time
  16.            - Kohonen (by Univ. of Tuebingen)
  17.  
  18.   AUTHOR         : Niels Mache
  19.   DATE           : 01.10.90
  20.  
  21.   CHANGED BY     : Sven Doering, Michael Vogt, Martin Reczko ,Guenter Mamier
  22.   IDENTIFICATION : @(#)learn_f.c    1.41 4/25/94
  23.   SCCS VERSION   : 1.41
  24.   LAST CHANGE    : 4/25/94
  25.  
  26.              Copyright (c) 1990-1994  SNNS Group, IPVR, Univ. Stuttgart, FRG
  27.  
  28. ******************************************************************************/
  29. #include <stdio.h>
  30. #include <math.h>
  31. #include <values.h>
  32.  
  33. #include "kr_typ.h"        /* Kernel Types and Constants  */
  34. #include "kr_const.h"        /* Constant Declarators for SNNS-Kernel  */
  35. #include "kr_def.h"        /* Default Values  */
  36. #include "kernel.h"        /* kernel function prototypes  */
  37. #include "kr_mac.h"        /* Kernel Macros   */
  38. #include "glob_typ.h"
  39. #include "kr_art.h"
  40. #include "kr_art1.h"
  41. #include "kr_art2.h"
  42. #include "kr_amap.h"
  43. #include "krart_df.h"
  44. #include "kr_newpattern.h"
  45. #include "kr_JordElm.h"
  46.  
  47. #include "learn_f.ph"
  48.  
  49.  
  50.  
  51.  
  52.  
  53.  
  54. /*****************************************************************************
  55.  *****************************************************************************
  56.  
  57.   GROUP        : backpropagation learning algorithm
  58.  
  59.   AUTHOR       : Niels Mache
  60.   DATE         : 01.01.1990
  61.   LAST CHANGE  : 18.03.1994
  62.  
  63.              Copyright (c) 1990-1994  SNNS Group, IPVR, Univ. Stuttgart, FRG
  64.              
  65. ******************************************************************************
  66. ******************************************************************************/
  67.  
  68.  
  69. /*****************************************************************************
  70.   FUNCTION : propagateNetForward
  71.  
  72.   PURPOSE  : forward pass for most of the learning algorithms
  73.   RETURNS  : 
  74.   NOTES    : topological forward propagation
  75.  
  76.   UPDATE   : 05.11.1993
  77. ******************************************************************************/
  78. static void propagateNetForward(int pattern_no, int sub_pat_no)
  79. {
  80.     register struct Unit *unit_ptr;
  81.     register Patterns in_pat;
  82.     register TopoPtrArray topo_ptr;
  83.  
  84.  
  85.     /* calculate startaddress for input pattern array  */
  86.     in_pat = kr_getSubPatData(pattern_no,sub_pat_no,INPUT,NULL);
  87.     if(in_pat == NULL){
  88.     KernelErrorCode = KRERR_NP_NO_SUCH_PATTERN;
  89.     return;
  90.     }
  91.  
  92.     topo_ptr = topo_ptr_array;
  93.  
  94.     /* copy pattern into input unit's activation and calculate output of the
  95.        input units */
  96.     while ((unit_ptr = *++topo_ptr) != NULL) {    
  97.     
  98.     /* topo_ptr points to a (topological sorted) unit
  99.        stucture (input unit first)  */
  100.     if (unit_ptr->out_func == OUT_IDENTITY)
  101.         /* identity output function: there is no need to call the output
  102.            function  */
  103.         unit_ptr->Out.output = unit_ptr->act = *in_pat++;
  104.     else
  105.         /* no identity output function: calculate unit's output also  */
  106.         unit_ptr->Out.output 
  107.         = (*unit_ptr->out_func) (unit_ptr->act = *in_pat++);
  108.     }
  109.  
  110.     /* popagate hidden units  */
  111.     while ((unit_ptr = *++topo_ptr) != NULL) {    /* topo_ptr points to a
  112.                            (topological sorted) unit
  113.                            stucture */
  114.     /* clear error values  */
  115.     unit_ptr->Aux.flint_no = 0.0;
  116.  
  117.     /* calculate the activation value of the unit: call the activation
  118.        function if needed  */
  119.     unit_ptr->act = (*unit_ptr->act_func) (unit_ptr);
  120.  
  121.     if (unit_ptr->out_func == OUT_IDENTITY)
  122.         /* identity output function: there is no need to call the output
  123.            function  */
  124.         unit_ptr->Out.output = unit_ptr->act;
  125.     else
  126.         /* no identity output function: calculate unit's output also  */
  127.         unit_ptr->Out.output = (*unit_ptr->out_func) (unit_ptr->act);
  128.     }
  129.  
  130.     /* popagate output units  */
  131.     while ((unit_ptr = *++topo_ptr) != NULL) {    /* topo_ptr points to a
  132.                            (topological sorted) unit
  133.                            stucture */
  134.     /* clear error values  */
  135.     unit_ptr->Aux.flint_no = 0.0;
  136.  
  137.     /* calculate the activation value of the unit: call the activation
  138.        function if needed  */
  139.     unit_ptr->act = (*unit_ptr->act_func) (unit_ptr);
  140.  
  141.     if (unit_ptr->out_func == OUT_IDENTITY)
  142.         /* identity output function: there is no need to call the output
  143.            function  */
  144.         unit_ptr->Out.output = unit_ptr->act;
  145.     else
  146.         /* no identity output function: calculate unit's output also  */
  147.         unit_ptr->Out.output = (*unit_ptr->out_func) (unit_ptr->act);
  148.     }
  149. }
  150.  
  151.  
  152.  
  153. /*****************************************************************************
  154.   FUNCTION : propagateNetBackward2
  155.  
  156.   PURPOSE  : backward pass of the backprop learning algorithm
  157.   RETURNS  : network error
  158.   NOTES    : network must be topologically sorted
  159.  
  160.   UPDATE   : 07.02.1994 by Sven Doering 
  161. ******************************************************************************/
  162. static float propagateNetBackward2(int pattern_no, int sub_pat_no, 
  163.                    float learn_parameter, float delta_max)
  164. {
  165.     register struct Link *link_ptr;
  166.     register struct Site *site_ptr;
  167.     register struct Unit *unit_ptr;
  168.     register Patterns out_pat;
  169.     register float  error, sum_error, eta, devit, learn_error;
  170.     register TopoPtrArray topo_ptr;
  171.     int size;
  172.  
  173.     sum_error = 0.0;        /* reset network error  */
  174.     eta = learn_parameter;    /* store learn_parameter in CPU register  */
  175.  
  176.     /* calculate address of the output pattern (with number pattern_no + 1)  */
  177.     out_pat = kr_getSubPatData(pattern_no,sub_pat_no,OUTPUT,&size);
  178.     if(out_pat == NULL){
  179.     KernelErrorCode = KRERR_NP_NO_SUCH_PATTERN;
  180.     return(-1);
  181.     }
  182.     out_pat += size;
  183.  
  184.  
  185.     /* add 3 to no_of_topo_units because the topologic array contains 4 NULL
  186.        pointers  */
  187.     topo_ptr = topo_ptr_array + (no_of_topo_units + 3);
  188.  
  189.     /* calculate output units only  */
  190.     while ((unit_ptr = *--topo_ptr) != NULL) {
  191.     devit = *(--out_pat) - unit_ptr->Out.output; /* calc. devitation */
  192.     if ((float) fabs(devit) <= delta_max)
  193.         continue;
  194.  
  195.     sum_error += devit * devit; /* sum up the error of the network  */
  196.  
  197.     /* calc. error for output units     */
  198.     error = devit * (unit_ptr->act_deriv_func) (unit_ptr);
  199.     /* calc. the error for adjusting weights and bias of the pred.
  200.        units  */
  201.     if (IS_SPECIAL_UNIT(unit_ptr))
  202.         learn_error = 0.0;
  203.     else
  204.         learn_error = eta * error;
  205.     /* adjust bias value  */
  206.     unit_ptr->bias += learn_error;
  207.  
  208.     if (UNIT_HAS_DIRECT_INPUTS(unit_ptr)) {
  209.         /* the unit has direkt links  */
  210.         FOR_ALL_LINKS(unit_ptr, link_ptr) { /* adjust links and
  211.                            calc. errors of the
  212.                            predecessor units  */
  213.             link_ptr->to->Aux.flint_no += link_ptr->weight * error;
  214.             link_ptr->weight += learn_error * link_ptr->to->Out.output;
  215.         }
  216.         } else {        /* the unit has sites  */
  217.         FOR_ALL_SITES_AND_LINKS(unit_ptr, site_ptr, link_ptr) {    
  218.             /* adjust links and calc. errors of the predecessor units */
  219.             link_ptr->to->Aux.flint_no += link_ptr->weight * error;
  220.             link_ptr->weight += learn_error * link_ptr->to->Out.output;
  221.         }
  222.         }
  223.     }
  224.  
  225.     /* calculate hidden units only  */
  226.     while ((unit_ptr = *--topo_ptr) != NULL) {
  227.     /* calc. the error of the (hidden) unit  */
  228.     error = (unit_ptr->act_deriv_func) (unit_ptr) * 
  229.         unit_ptr->Aux.flint_no;
  230.     /* calc. the error for adjusting weights and bias of the pred.
  231.        units  */
  232.     if (IS_SPECIAL_UNIT(unit_ptr)) 
  233.         learn_error =0.0;
  234.     else
  235.         learn_error = eta * error;
  236.     /* adjust bias value  */
  237.     unit_ptr->bias += learn_error;
  238.  
  239.     if (UNIT_HAS_DIRECT_INPUTS(unit_ptr)) {
  240.         /* the unit has direkt links     */
  241.         FOR_ALL_LINKS(unit_ptr, link_ptr) {    /* adjust links and
  242.                            calc. sum of errors
  243.                            of the pred. units */
  244.             if IS_HIDDEN_UNIT
  245.             (link_ptr->to)
  246.             /* this link points to a hidden unit: sum up the
  247.                error's from previos units  */
  248.                 link_ptr->to->Aux.flint_no += 
  249.                 link_ptr->weight * error;
  250.             link_ptr->weight
  251.             += learn_error * link_ptr->to->Out.output;
  252.         }
  253.         } else {        /* the unit has sites  */
  254.         FOR_ALL_SITES_AND_LINKS(unit_ptr, site_ptr, link_ptr) {    
  255.             /* adjust links and calc sum of errors of the pred. units */
  256.             if IS_HIDDEN_UNIT
  257.             (link_ptr->to)
  258.             /* this link points to a hidden unit: sum up the
  259.                error's from previos units  */
  260.                 link_ptr->to->Aux.flint_no += 
  261.                 link_ptr->weight * error;
  262.             link_ptr->weight
  263.             += learn_error * link_ptr->to->Out.output;
  264.         }
  265.         }
  266.     }
  267.  
  268.     return (sum_error);        /* return the error of the network */
  269. }
  270.  
  271.  
  272.  
  273. /*****************************************************************************
  274.   FUNCTION : LEARN_backprop
  275.  
  276.   PURPOSE  : main routine for the backpropagation algorithm
  277.   RETURNS  : kernel error code
  278.   NOTES    : Input Parameters:   1 : learning parameter
  279.                                  2 : delta max
  280.  
  281.              Output Parameters:  1 : error of the network (sum of all cycles)
  282.  
  283.  
  284.   UPDATE   : 05.11.1993
  285. ******************************************************************************/
  286. krui_err LEARN_backprop(int start_pattern, int end_pattern,
  287.             float *parameterInArray, int NoOfInParams,
  288.             float **parameterOutArray, int *NoOfOutParams)
  289. {
  290.     static float    OutParameter[1];    /* OutParameter[0] stores the
  291.                        learning error */
  292.     int             i, pattern_no, sub_pat_no, no_of_layers;
  293.  
  294.  
  295.     KernelErrorCode = KRERR_NO_ERROR;    /* reset return code  */
  296.  
  297.     /* ####  have to be changed (must be 2)  #### */
  298.     if (NoOfInParams < 1) {    /* Not enough input parameters     */
  299.     KernelErrorCode = KRERR_PARAMETERS;
  300.     return (KernelErrorCode);
  301.     }
  302.     *NoOfOutParams = 1;        /* One return value is available (the
  303.                    learning error)  */
  304.     *parameterOutArray = OutParameter;    /* set the output parameter reference */
  305.  
  306.     if (NetModified || (TopoSortID != TOPOLOGICAL_FF)) {
  307.     /* Net has been modified or topologic array isn't initialized */
  308.     /* check the topology of the network  */
  309.     no_of_layers = kr_topoCheck();
  310.     if (KernelErrorCode != KRERR_NO_ERROR)
  311.         /* an error has occured     */
  312.         return (KernelErrorCode);
  313.  
  314.     if (no_of_layers < 2) {    /* the network has less then 2 layers  */
  315.         KernelErrorCode = KRERR_FEW_LAYERS;
  316.         return (KernelErrorCode);
  317.     }
  318.     /* count the no. of I/O units and check the patterns  */
  319.     if (kr_IOCheck() != KRERR_NO_ERROR)
  320.         return (KernelErrorCode);
  321.  
  322.     /* sort units by topology and by topologic type  */
  323.     (void) kr_topoSort(TOPOLOGICAL_FF);
  324.     if ((KernelErrorCode != KRERR_NO_ERROR) &&
  325.         (KernelErrorCode != KRERR_DEAD_UNITS))
  326.         return (KernelErrorCode);
  327.  
  328.     NetModified = FALSE;
  329.     }
  330.  
  331.  
  332.     /* compute the necessary sub patterns */
  333.  
  334.     KernelErrorCode = kr_initSubPatternOrder(start_pattern,end_pattern);
  335.     if(KernelErrorCode != KRERR_NO_ERROR)
  336.     return (KernelErrorCode);
  337.  
  338.  
  339.     NET_ERROR(OutParameter) = 0.0;    /* reset network error value  */
  340.  
  341.     while(kr_getSubPatternByOrder(&pattern_no,&sub_pat_no)){
  342.  
  343.     propagateNetForward(pattern_no,sub_pat_no);   /* Forward propagation */
  344.  
  345.     /* Backward propagation  */
  346.     /* 1st parameter is the learning parameter 2nd parameter is the max.
  347.        devitation between output pattern and the output of the output
  348.        unit (delta max) */
  349.     NET_ERROR(OutParameter) +=
  350.         propagateNetBackward2(pattern_no,sub_pat_no,
  351.                   LEARN_PARAM1(parameterInArray),
  352.                   LEARN_PARAM2(parameterInArray));
  353.     }
  354.  
  355.     return (KernelErrorCode);
  356. }
  357.  
  358.  
  359.  
  360. /*****************************************************************************
  361.   FUNCTION : propagateNetBackwardBatch
  362.  
  363.   PURPOSE  : backward pass in batch mode for the backprop learning algorithm
  364.   RETURNS  : network error
  365.   NOTES    :
  366.  
  367.   UPDATE   : 05.11.1993 by Guenter Mamier
  368. ******************************************************************************/
  369. static float propagateNetBackwardBatch(int pattern_no, int sub_pat_no,  
  370.                        float delta_max)
  371. {
  372.     register struct Link *link_ptr;
  373.     register struct Site *site_ptr;
  374.     register struct Unit *unit_ptr;
  375.     register Patterns out_pat;
  376.     register float  error, sum_error, devit;
  377.     register TopoPtrArray topo_ptr;
  378.     int size;
  379.  
  380.     sum_error = 0.0;        /* reset network error  */
  381.     /* calculate address of the output pattern (with number pattern_no + 1)  */
  382.     out_pat = kr_getSubPatData(pattern_no,sub_pat_no,OUTPUT,&size);
  383.     if(out_pat == NULL){
  384.     KernelErrorCode = KRERR_NP_NO_SUCH_PATTERN;
  385.     return(-1);
  386.     }
  387.     out_pat += size;
  388.  
  389.     /* add 3 to no_of_topo_units because the topologic array contains 4 NULL
  390.        pointers  */
  391.     topo_ptr = topo_ptr_array + (no_of_topo_units + 3);
  392.  
  393.     /* calculate output units only  */
  394.     /* no test for special units takes place because the final weight */
  395.     /* change is performed  by updateWeights */
  396.     while ((unit_ptr = *--topo_ptr) != NULL) {
  397.     devit = *(--out_pat) - unit_ptr->Out.output; /* calc. devitation */
  398.     if ((float) fabs(devit) <= delta_max)
  399.         continue;
  400.  
  401.     sum_error += devit * devit; /* sum up the error of the network  */
  402.  
  403.     /* calc. error for output units     */
  404.     error = devit * (unit_ptr->act_deriv_func) (unit_ptr);
  405.     /* calc. the error for adjusting weights and bias of the pred.
  406.        units  */
  407.     /* adjust bias value  */
  408.     unit_ptr->value_a += error;
  409.  
  410.     if (UNIT_HAS_DIRECT_INPUTS(unit_ptr)) {
  411.         /* the unit has direkt links  */
  412.         FOR_ALL_LINKS(unit_ptr, link_ptr) {    /* adjust links and
  413.                            calc. sum of errors
  414.                            of pred. units  */
  415.         link_ptr->to->Aux.flint_no += link_ptr->weight * error;
  416.         link_ptr->value_a += error * link_ptr->to->Out.output;
  417.         }
  418.     } else {
  419.         /* the unit has sites  */
  420.         FOR_ALL_SITES_AND_LINKS(unit_ptr, site_ptr, link_ptr) {    
  421.         /* adjust links and calc. sum of errors of pred. units */
  422.         link_ptr->to->Aux.flint_no += link_ptr->weight * error;
  423.         link_ptr->value_a += error * link_ptr->to->Out.output;
  424.         }
  425.     }
  426.     }
  427.  
  428.     /* calculate hidden units only  */
  429.     /* no test for special units takes place because the final weight */
  430.     /* change is performed  by updateWeights */
  431.     while ((unit_ptr = *--topo_ptr) != NULL) {
  432.     /* calc. the error of the (hidden) unit  */
  433.     error = (unit_ptr->act_deriv_func) (unit_ptr) * 
  434.         unit_ptr->Aux.flint_no;
  435.     /* calc. the error for adjusting weights and bias of the pred.
  436.        units  */
  437.     /* adjust bias value  */
  438.     unit_ptr->value_a += error;
  439.  
  440.     if (UNIT_HAS_DIRECT_INPUTS(unit_ptr)) {
  441.         /* the unit has direkt links     */
  442.         FOR_ALL_LINKS(unit_ptr, link_ptr) {    
  443.         /* adjust links and calc sum of errors of the pred. units */
  444.         if IS_HIDDEN_UNIT
  445.             (link_ptr->to)
  446.             /* this link points to a hidden unit: sum up the
  447.                error's from previos units  */
  448.             link_ptr->to->Aux.flint_no += 
  449.                 link_ptr->weight * error;
  450.         link_ptr->value_a += error * link_ptr->to->Out.output;
  451.         }
  452.     } else {
  453.         /* the unit has sites  */
  454.         FOR_ALL_SITES_AND_LINKS(unit_ptr, site_ptr, link_ptr) {    
  455.         /* adjust links and calc sum of errors of the pred. units */
  456.         if IS_HIDDEN_UNIT
  457.             (link_ptr->to)
  458.             /* this link points to a hidden unit: sum up the
  459.                error's from previos units  */
  460.             link_ptr->to->Aux.flint_no
  461.                 += link_ptr->weight * error;
  462.         link_ptr->value_a += error * link_ptr->to->Out.output;
  463.         }
  464.     }
  465.     }
  466.  
  467.     return (sum_error);        /* return the error of the network */
  468. }
  469.  
  470.  
  471. /*****************************************************************************
  472.   FUNCTION : clearDeltas
  473.  
  474.   PURPOSE  : clears delta values for a new run of backprop batch
  475.   RETURNS  : kernel error code
  476.   NOTES    :
  477.  
  478.   UPDATE   : 05.11.1993 by Guenter Mamier
  479. ******************************************************************************/
  480. static krui_err clearDeltas(void)
  481. {
  482.     register FlagWord flags;
  483.     register struct Link *link_ptr;
  484.     register struct Unit *unit_ptr;
  485.     register struct Site *site_ptr;
  486.  
  487.  
  488.     FOR_ALL_UNITS(unit_ptr) {
  489.     flags = unit_ptr->flags;
  490.  
  491.     if ((flags & UFLAG_IN_USE) == UFLAG_IN_USE) {    /* unit is in use  */
  492.         unit_ptr->value_a = (FlintType) 0;
  493.  
  494.         if (flags & UFLAG_SITES) {    /* unit has sites  */
  495.         FOR_ALL_SITES_AND_LINKS(unit_ptr, site_ptr, link_ptr)
  496.             link_ptr->value_a = (FlintType) 0;
  497.         } else {        /* unit has no sites   */
  498.         if (flags & UFLAG_DLINKS) {    /* unit has direct links   */
  499.             FOR_ALL_LINKS(unit_ptr, link_ptr)
  500.             link_ptr->value_a = (FlintType) 0;
  501.         }
  502.         }
  503.     }
  504.     }
  505.  
  506.     return (KRERR_NO_ERROR);
  507. }
  508.  
  509.  
  510.  
  511. /*****************************************************************************
  512.   FUNCTION : updateWeights
  513.  
  514.   PURPOSE  : Update the weights after all patterns have been presented by 
  515.              backpropBatch 
  516.   RETURNS  : kernel error code
  517.   NOTES    :
  518.  
  519.   UPDATE   : 05.11.1993 by Guenter Mamier
  520. ******************************************************************************/
  521. static krui_err updateWeights(float eta)
  522. {
  523.     register FlagWord flags;
  524.     register struct Link *link_ptr;
  525.     register struct Unit *unit_ptr;
  526.     register struct Site *site_ptr;
  527.  
  528.  
  529.     FOR_ALL_UNITS(unit_ptr) {
  530.     if (!IS_SPECIAL_UNIT(unit_ptr)) {
  531.         flags = unit_ptr->flags;
  532.  
  533.         if ((flags & UFLAG_IN_USE) == UFLAG_IN_USE) {
  534.         /* unit is in use  */
  535.         unit_ptr->bias += unit_ptr->value_a * eta;
  536.  
  537.         if (flags & UFLAG_SITES) {
  538.             /* unit has sites  */
  539.             FOR_ALL_SITES_AND_LINKS(unit_ptr, site_ptr, link_ptr)
  540.             link_ptr->weight += link_ptr->value_a * eta;
  541.         } else {
  542.             /* unit has no sites   */
  543.             if (flags & UFLAG_DLINKS) {    /* unit has direct links    */
  544.             FOR_ALL_LINKS(unit_ptr, link_ptr)
  545.                 link_ptr->weight += link_ptr->value_a * eta;
  546.             }
  547.         }
  548.         }
  549.     }
  550.     }
  551.     return (KRERR_NO_ERROR);
  552. }
  553.  
  554.  
  555.  
  556.  
  557. /*****************************************************************************
  558.   FUNCTION : LEARN_backpropBatch
  559.  
  560.   PURPOSE  : main routine for the batch version of the backpropagation 
  561.              algorithm
  562.   RETURNS  : kernel error code
  563.   NOTES    : Input Parameters:   1 : learning parameter
  564.                                  2 : delta max
  565.  
  566.              Output Parameters:  1 : error of the network (sum of all cycles)
  567.  
  568.   UPDATE   : 05.11.1993 by Guenter Mamier
  569. ******************************************************************************/
  570. krui_err  LEARN_backpropBatch(int start_pattern, int end_pattern, 
  571.                   float *parameterInArray, int NoOfInParams, 
  572.                   float **parameterOutArray, int *NoOfOutParams)
  573. {
  574.     static float    OutParameter[1];    /* OutParameter[0] stores the
  575.                        learning error  */
  576.     int             i, pattern_no, sub_pat_no, no_of_layers;
  577.  
  578.  
  579.     KernelErrorCode = KRERR_NO_ERROR;    /* reset return code  */
  580.  
  581.     /* ####  have to be changed (must be 2)  #### */
  582.     if (NoOfInParams < 1) {    /* Not enough input parameters     */
  583.     KernelErrorCode = KRERR_PARAMETERS;
  584.     return (KernelErrorCode);
  585.     }
  586.     *NoOfOutParams = 1;      /* One return value is available ( learning error)  */
  587.     *parameterOutArray = OutParameter;    /* set the output parameter reference */
  588.  
  589.     if (NetModified || (TopoSortID != TOPOLOGICAL_FF)) {    
  590.     /* Net has been modified or topologic array isn't initialized */
  591.     /* check the topology of the network  */
  592.     no_of_layers = kr_topoCheck();
  593.     if (KernelErrorCode != KRERR_NO_ERROR)
  594.         /* an error has occured     */
  595.         return (KernelErrorCode);
  596.  
  597.     if (no_of_layers < 2) {    /* the network has less then 2 layers  */
  598.         KernelErrorCode = KRERR_FEW_LAYERS;
  599.         return (KernelErrorCode);
  600.     }
  601.     /* count the no. of I/O units and check the patterns  */
  602.     if (kr_IOCheck() != KRERR_NO_ERROR)
  603.         return (KernelErrorCode);
  604.  
  605.     /* sort units by topology and by topologic type  */
  606.     (void) kr_topoSort(TOPOLOGICAL_FF);
  607.     if ((KernelErrorCode != KRERR_NO_ERROR) && 
  608.         (KernelErrorCode != KRERR_DEAD_UNITS))
  609.         return (KernelErrorCode);
  610.  
  611.     NetModified = FALSE;
  612.     }
  613.     clearDeltas();
  614.  
  615.     /* compute the necessary sub patterns */
  616.  
  617.     KernelErrorCode = kr_initSubPatternOrder(start_pattern,end_pattern);
  618.     if(KernelErrorCode != KRERR_NO_ERROR)
  619.     return (KernelErrorCode);
  620.  
  621.  
  622.     NET_ERROR(OutParameter) = 0.0;    /* reset network error value  */
  623.  
  624.     while(kr_getSubPatternByOrder(&pattern_no,&sub_pat_no)){
  625.  
  626.     propagateNetForward(pattern_no,sub_pat_no);  /* Forward propagation */
  627.  
  628.     /* Backward propagation  */
  629.     /* 1st parameter is the learning parameter 2nd parameter is the max.
  630.        devitation between output pattern and the output of the output
  631.        unit (delta max) */
  632.     NET_ERROR(OutParameter) +=
  633.         propagateNetBackwardBatch(pattern_no,sub_pat_no,
  634.                       LEARN_PARAM2(parameterInArray));
  635.     }
  636.  
  637.     updateWeights(LEARN_PARAM1(parameterInArray));
  638.  
  639.  
  640.     return (KernelErrorCode);
  641. }
  642.  
  643.  
  644. /*****************************************************************************
  645.  *****************************************************************************
  646.  
  647.   GROUP        : backpropagation learning algorithm with momentum term
  648.  
  649.   AUTHOR       : Niels Mache
  650.   DATE         : 01.01.1990
  651.   LAST CHANGE  : 05.11.1993
  652.  
  653.              Copyright (c) 1990-1994  SNNS Group, IPVR, Univ. Stuttgart, FRG
  654.              
  655. ******************************************************************************
  656. ******************************************************************************/
  657.  
  658.  
  659. /*****************************************************************************
  660.   FUNCTION : initializeBackpropMomentum
  661.  
  662.   PURPOSE  : backprop-momentum initialisation
  663.   RETURNS  : kernel error code
  664.   NOTES    :
  665.  
  666.   UPDATE   : 05.11.1993 by Guenter Mamier
  667. ******************************************************************************/
  668. static krui_err initializeBackpropMomentum(void)
  669. {
  670.     register FlagWord flags;
  671.     register struct Link *link_ptr;
  672.     register struct Unit *unit_ptr;
  673.     register struct Site *site_ptr;
  674.  
  675.  
  676.     FOR_ALL_UNITS(unit_ptr) {
  677.     flags = unit_ptr->flags;
  678.  
  679.     if ((flags & UFLAG_IN_USE) == UFLAG_IN_USE) {    /* unit is in use  */
  680.         unit_ptr->value_a = (FlintType) 0;
  681.  
  682.         if (flags & UFLAG_SITES) {    /* unit has sites  */
  683.         FOR_ALL_SITES_AND_LINKS(unit_ptr, site_ptr, link_ptr)
  684.             link_ptr->value_b = (FlintType) 0;
  685.         } else {        /* unit has no sites   */
  686.         if (flags & UFLAG_DLINKS) {    /* unit has direct links   */
  687.             FOR_ALL_LINKS(unit_ptr, link_ptr)
  688.             link_ptr->value_b = (FlintType) 0;
  689.         }
  690.         }
  691.     }
  692.     }
  693.  
  694.     return (KRERR_NO_ERROR);
  695. }
  696.  
  697.  
  698.  
  699.  
  700. /*****************************************************************************
  701.   FUNCTION : Backprop_momentum_FSE
  702.   PURPOSE  : Backward error propagation (topological) of backpropagation 
  703.              learnig function with momentum term and flat spot elimination
  704.  
  705.   RETURNS  : network error
  706.   NOTES    :
  707.  
  708.   UPDATE   : 07.02.1994 by Sven Doering
  709. ******************************************************************************/
  710. static float Backprop_momentum_FSE(int pattern_no, int sub_pat_no, 
  711.                    float learn_parameter, 
  712.                    float mu, float FSE_term, float delta_max)
  713. {
  714.     register struct Link *link_ptr;
  715.     register struct Site *site_ptr;
  716.     register struct Unit *unit_ptr;
  717.     register Patterns out_pat;
  718.     register float  error, sum_error, eta, devit, learn_error, mu_help;
  719.     register TopoPtrArray topo_ptr;
  720.     int size;
  721.  
  722.  
  723.     sum_error = 0.0;        /* reset network error  */
  724.     eta = learn_parameter;    /* store learn_parameter in CPU register  */
  725.  
  726.     /* calculate address of the output pattern (with number pattern_no + 1)  */
  727.     out_pat = kr_getSubPatData(pattern_no,sub_pat_no,OUTPUT,&size);
  728.     if(out_pat == NULL){
  729.     KernelErrorCode = KRERR_NP_NO_SUCH_PATTERN;
  730.     return(-1);
  731.     }
  732.     out_pat += size;
  733.  
  734.  
  735.     /* add 3 to no_of_topo_units because the topologic array contains 4 NULL
  736.        pointers  */
  737.     topo_ptr = topo_ptr_array + (no_of_topo_units + 3);
  738.  
  739.     /* calculate output units only  */
  740.     while ((unit_ptr = *--topo_ptr) != NULL) {
  741.     devit = *(--out_pat) - unit_ptr->Out.output;    /* calc. devitation */
  742.     if ((float) fabs(devit) <= delta_max)
  743.         continue;
  744.  
  745.     sum_error += devit * devit;    /* sum up the error of the network  */
  746.     /* calc. error for output units     */
  747.     error = devit * ((unit_ptr->act_deriv_func) (unit_ptr) + FSE_term);
  748.  
  749.     /* calc. the error for adjusting weights and bias of the predecessor
  750.        units  */
  751.     mu_help = mu;
  752.     learn_error = eta * error;
  753.     if(IS_SPECIAL_UNIT( unit_ptr )){
  754.         learn_error = 0.0;
  755.         mu = 0.0;
  756.     }
  757.     unit_ptr->value_a = learn_error + mu * unit_ptr->value_a;
  758.     /* adjust bias value  */
  759.     unit_ptr->bias += unit_ptr->value_a;
  760.  
  761.     if (UNIT_HAS_DIRECT_INPUTS(unit_ptr)) {    /* the unit has direkt links  */
  762.         FOR_ALL_LINKS(unit_ptr, link_ptr) {    /* adjust link weights and
  763.                            calc. sum of errors of the
  764.                            predecessor units  */
  765.         link_ptr->to->Aux.flint_no += link_ptr->weight * error;
  766.         link_ptr->value_b = learn_error * link_ptr->to->Out.output + 
  767.                             mu * link_ptr->value_b;
  768.         link_ptr->weight += link_ptr->value_b;
  769.         }
  770.     } else {        /* the unit has sites  */
  771.         FOR_ALL_SITES_AND_LINKS(unit_ptr, site_ptr, link_ptr) {    
  772.         /* adjust links and calc. sum of errors of the pred. units */
  773.         link_ptr->to->Aux.flint_no += link_ptr->weight * error;
  774.         link_ptr->value_b = learn_error * link_ptr->to->Out.output + 
  775.                             mu * link_ptr->value_b;
  776.         link_ptr->weight += link_ptr->value_b;
  777.         }
  778.     }
  779.     mu = mu_help;
  780.     }
  781.  
  782.  
  783.     /* calculate hidden units only  */
  784.     while ((unit_ptr = *--topo_ptr) != NULL) {
  785.     /* calc. the error of the (hidden) unit  */
  786.     error = unit_ptr->Aux.flint_no * 
  787.             ((unit_ptr->act_deriv_func) (unit_ptr) + FSE_term);
  788.  
  789.     /* calc. the error for adjusting weights and bias of the pred. units */
  790.     mu_help = mu;
  791.     learn_error = eta * error;
  792.     if(IS_SPECIAL_UNIT( unit_ptr )){
  793.         learn_error = 0.0;
  794.         mu = 0.0;
  795.     }
  796.     unit_ptr->value_a = learn_error + mu * unit_ptr->value_a;
  797.     /* adjust bias value  */
  798.     unit_ptr->bias += unit_ptr->value_a;
  799.  
  800.     if (UNIT_HAS_DIRECT_INPUTS(unit_ptr)) {    /* the unit has direkt links */
  801.         FOR_ALL_LINKS(unit_ptr, link_ptr) {    /* adjust link weights and
  802.                            calc. sum of errors of the
  803.                            predecessor units  */
  804.         if IS_HIDDEN_UNIT
  805.             (link_ptr->to)
  806.             /* this link points to a hidden unit: sum up the error's
  807.                from previos units  */
  808.             link_ptr->to->Aux.flint_no += link_ptr->weight * error;
  809.  
  810.         link_ptr->value_b = learn_error * link_ptr->to->Out.output + 
  811.                             mu * link_ptr->value_b;
  812.         link_ptr->weight += link_ptr->value_b;
  813.         }
  814.     } else {        /* the unit has sites  */
  815.         FOR_ALL_SITES_AND_LINKS(unit_ptr, site_ptr, link_ptr) {    
  816.         /* adjust links and calc. sum of errors of the pred. units */
  817.         if IS_HIDDEN_UNIT
  818.             (link_ptr->to)
  819.             /* this link points to a hidden unit: sum up the error's
  820.                from previos units  */
  821.             link_ptr->to->Aux.flint_no += link_ptr->weight * error;
  822.  
  823.         link_ptr->value_b = learn_error * link_ptr->to->Out.output + 
  824.                             mu * link_ptr->value_b;
  825.         link_ptr->weight += link_ptr->value_b;
  826.         }
  827.     }
  828.     mu = mu_help;
  829.     }
  830.  
  831.     return (sum_error);        /* return the error of the network */
  832. }
  833.  
  834.  
  835. /*****************************************************************************
  836.   FUNCTION : LEARN_backpropMomentum
  837.  
  838.   PURPOSE  : main routine for backpropagation with momentum
  839.   RETURNS  : kernel error code
  840.   NOTES    : Input Parameters:   1 : learning parameter
  841.                                  2 : momentum term
  842.                  3 : flat-spot-elimination value
  843.                  4 : delta max
  844.  
  845.              Output Parameters:  1 : error of the network (sum of all cycles)
  846.  
  847.   UPDATE   : 05.11.1993 by Guenter Mamier
  848. ******************************************************************************/
  849. krui_err LEARN_backpropMomentum(int start_pattern, int end_pattern, 
  850.                 float *parameterInArray, int NoOfInParams, 
  851.                 float **parameterOutArray, int *NoOfOutParams)
  852. {
  853.     static float OutParameter[1];  /*OutParameter[0] stores the learning error*/
  854.     int          i, ret_code, pattern_no, sub_pat_no;
  855.  
  856.  
  857.     if (NoOfInParams < 1)    /* ####  have to be changed (must be 2)  #### */
  858.     return (KRERR_PARAMETERS);    /* Not enough input parameters  */
  859.  
  860.     *NoOfOutParams = 1;        /* One return value is available (the
  861.                    learning error)  */
  862.     *parameterOutArray = OutParameter;    /* set the output parameter reference */
  863.     ret_code = KRERR_NO_ERROR;    /* reset return code  */
  864.  
  865.     if (NetModified || (TopoSortID != TOPOLOGICAL_FF)) {    
  866.     /* Net has been modified or topologic array isn't initialized */
  867.     /* check the topology of the network  */
  868.     ret_code = kr_topoCheck();
  869.     if (ret_code < KRERR_NO_ERROR)
  870.         return (ret_code);    /* an error has occured  */
  871.     if (ret_code < 2)
  872.         return (KRERR_FEW_LAYERS);    /* the network has less then 2 layers */
  873.  
  874.     /* count the no. of I/O units and check the patterns  */
  875.     ret_code = kr_IOCheck();
  876.     if (ret_code < KRERR_NO_ERROR)
  877.         return (ret_code);
  878.  
  879.     /* sort units by topology and by topologic type  */
  880.     ret_code = kr_topoSort(TOPOLOGICAL_FF);
  881.     if ((ret_code != KRERR_NO_ERROR) && (ret_code != KRERR_DEAD_UNITS))
  882.         return (ret_code);
  883.  
  884.     NetModified = FALSE;
  885.     }
  886.     if (NetInitialize || LearnFuncHasChanged) {    /* Net has been modified or
  887.                            initialized, initialize
  888.                            backprop now  */
  889.     ret_code = initializeBackpropMomentum();
  890.     if (ret_code != KRERR_NO_ERROR)
  891.         return (ret_code);
  892.     }
  893.  
  894.  
  895.     /* compute the necessary sub patterns */
  896.  
  897.     KernelErrorCode = kr_initSubPatternOrder(start_pattern,end_pattern);
  898.     if(KernelErrorCode != KRERR_NO_ERROR)
  899.     return (KernelErrorCode);
  900.  
  901.  
  902.     NET_ERROR(OutParameter) = 0.0;    /* reset network error value  */
  903.  
  904.     while(kr_getSubPatternByOrder(&pattern_no,&sub_pat_no)){
  905.  
  906.     propagateNetForward(pattern_no,sub_pat_no);    /* Forward propagation */
  907.  
  908.     /* Backward propagation  */
  909.     /* 1st parameter is the learning parameter 2nd parameter is the
  910.        momentum term 3rd parameter is the flat-spot-elimination value 4th
  911.        parameter is the max. devitation between output pattern and the
  912.        output of the output unit (delta max) */
  913.     NET_ERROR(OutParameter) +=
  914.         Backprop_momentum_FSE(pattern_no,sub_pat_no,
  915.                   LEARN_PARAM1(parameterInArray),
  916.                   LEARN_PARAM2(parameterInArray),
  917.                   LEARN_PARAM3(parameterInArray),
  918.                   LEARN_PARAM4(parameterInArray));
  919.     }
  920.  
  921.     return (ret_code);
  922. }
  923.  
  924.  
  925.  
  926.  
  927.  
  928. /*****************************************************************************
  929.  *****************************************************************************
  930.  
  931.   GROUP        : quickpropagation learning function
  932.  
  933.   AUTHOR       : Peter Zimmerer
  934.   DATE         : 01.01.1990
  935.   LAST CHANGE  : 05.11.1993
  936.  
  937.              Copyright (c) 1990-1994  SNNS Group, IPVR, Univ. Stuttgart, FRG
  938.              
  939. ******************************************************************************
  940. ******************************************************************************/
  941.  
  942. /*****************************************************************************
  943.   FUNCTION : initializeQuickprop
  944.  
  945.   PURPOSE  : initializes the quickprop learning
  946.   RETURNS  : kernel error code
  947.   NOTES    :
  948.  
  949.   UPDATE   : 05.11.1993 by Guenter Mamier
  950. ******************************************************************************/
  951. static krui_err initializeQuickprop(void)
  952. {
  953.     register unsigned short flags;
  954.     register struct Link *link_ptr;
  955.     register struct Unit *unit_ptr;
  956.     register struct Site *site_ptr;
  957.  
  958.  
  959.     FOR_ALL_UNITS(unit_ptr) {
  960.     flags = unit_ptr->flags;
  961.  
  962.     if ((flags & UFLAG_IN_USE) == UFLAG_IN_USE) {    /* unit is in use  */
  963.         unit_ptr->value_a = unit_ptr->value_b =
  964.         unit_ptr->value_c = (FlintType) 0;
  965.  
  966.         if (flags & UFLAG_SITES) {    /* unit has sites  */
  967.         FOR_ALL_SITES_AND_LINKS(unit_ptr, site_ptr, link_ptr)
  968.             link_ptr->value_a = link_ptr->value_b = 
  969.                             link_ptr->value_c = (FlintType) 0;
  970.         } else {        /* unit has no sites   */
  971.         if (flags & UFLAG_DLINKS) {    /* unit has direct links    */
  972.             FOR_ALL_LINKS(unit_ptr, link_ptr)
  973.             link_ptr->value_a = link_ptr->value_b = 
  974.                                 link_ptr->value_c = (FlintType) 0;
  975.         }
  976.         }
  977.     }
  978.     }
  979.  
  980.     return (KRERR_NO_ERROR);
  981. }
  982.  
  983.  
  984.  
  985. /*****************************************************************************
  986.   FUNCTION : propagateNetBackwardQuickprop
  987.  
  988.   PURPOSE  : quickprop backward error propagation
  989.   RETURNS  : network error
  990.   NOTES    : quickprop backward error propagation
  991.              (topological) for quickprop with SIGMOID_PRIME_OFFSET
  992.          batch-modus: without adaption of links and bias
  993.  
  994.   UPDATE   : 05.11.1993 by Guenter Mamier
  995. ******************************************************************************/
  996. static float propagateNetBackwardQuickprop(int pattern_no, int sub_pat_no, 
  997.                        float delta_max)
  998. {
  999.     register struct Link *link_ptr;
  1000.     register struct Site *site_ptr;
  1001.     register struct Unit *unit_ptr;
  1002.     register Patterns out_pat;
  1003.     register float  error,    /* error  */
  1004.     sum_error,            /* sum of the error  */
  1005.     devit;            /* deviation  */
  1006.     TopoPtrArray    topo_ptr;
  1007.     int size;
  1008.  
  1009.  
  1010.     sum_error = 0.0;        /* reset network error  */
  1011.  
  1012.     /* calculate address of the output pattern (with number pattern_no + 1)  */
  1013.     out_pat = kr_getSubPatData(pattern_no,sub_pat_no,OUTPUT,&size);
  1014.     out_pat += size;
  1015.  
  1016.     /* add 3 to no_of_topo_units because the topologic array contains 4 NULL
  1017.        pointers  */
  1018.     topo_ptr = topo_ptr_array + (no_of_topo_units + 3);
  1019.  
  1020.     /* calculate output units only  */
  1021.     while ((unit_ptr = *--topo_ptr) != NULL) {
  1022.     devit = *(--out_pat) - unit_ptr->Out.output;
  1023.     /* = o * (1.0 - o) in [0.0,0.25], */
  1024.     /* for asymmetric logistic function */
  1025.  
  1026.     if ((float) fabs(devit) <= delta_max)
  1027.         continue;
  1028.  
  1029.     sum_error += devit * devit; /* sum up the error of the network  */
  1030.  
  1031.     /* calc. error for output units     */
  1032.     error = devit * ((unit_ptr->act_deriv_func) (unit_ptr) +
  1033.              SIGMOID_PRIME_OFFSET);
  1034.  
  1035.     unit_ptr->value_c += -error; /* calculate the bias slopes  */
  1036.     /* learn bias like a weight  */
  1037.     if (UNIT_HAS_DIRECT_INPUTS(unit_ptr)) {
  1038.         /* the unit has direct links  */
  1039.         FOR_ALL_LINKS(unit_ptr, link_ptr) {    /* calculate the slopes */
  1040.         link_ptr->value_c += -error * link_ptr->to->Out.output;
  1041.         link_ptr->to->Aux.flint_no += link_ptr->weight * error;
  1042.         }
  1043.     } else {
  1044.         /* the unit has sites  */
  1045.         FOR_ALL_SITES_AND_LINKS(unit_ptr, site_ptr, link_ptr) {    
  1046.         /* calculate the value_cs  */
  1047.         link_ptr->value_c += -error * link_ptr->to->Out.output;
  1048.         link_ptr->to->Aux.flint_no += link_ptr->weight * error;
  1049.         }
  1050.     }
  1051.     }
  1052.  
  1053.  
  1054.     /* calculate hidden units only  */
  1055.     while ((unit_ptr = *--topo_ptr) != NULL) {
  1056.     error = ((unit_ptr->act_deriv_func) (unit_ptr) +
  1057.          SIGMOID_PRIME_OFFSET) * unit_ptr->Aux.flint_no;
  1058.  
  1059.     unit_ptr->value_c += -error; /* calculate the bias slopes  */
  1060.     /* learn bias like a weight  */
  1061.     if (UNIT_HAS_DIRECT_INPUTS(unit_ptr)) {
  1062.         /* the unit has direct links  */
  1063.         FOR_ALL_LINKS(unit_ptr, link_ptr) { /* calculate the slopes  */
  1064.         if IS_HIDDEN_UNIT
  1065.             (link_ptr->to)
  1066.             /* this link points to a hidden unit: sum up the
  1067.                error's from previos units  */
  1068.             link_ptr->to->Aux.flint_no += 
  1069.                 link_ptr->weight * error;
  1070.  
  1071.         link_ptr->value_c += -error * link_ptr->to->Out.output;
  1072.         }
  1073.     } else {
  1074.         /* the unit has sites  */
  1075.         FOR_ALL_SITES_AND_LINKS(unit_ptr, site_ptr, link_ptr) {    
  1076.         /* calculate the slopes  */
  1077.         if IS_HIDDEN_UNIT
  1078.             (link_ptr->to)
  1079.             /* this link points to a hidden unit: sum up the
  1080.                error's from previos units  */
  1081.             link_ptr->to->Aux.flint_no += 
  1082.                 link_ptr->weight * error;
  1083.  
  1084.         link_ptr->value_c += -error * link_ptr->to->Out.output;
  1085.         }
  1086.     }
  1087.     }
  1088.     return (sum_error);        /* return the error of the network  */
  1089. }
  1090.  
  1091.  
  1092. /*****************************************************************************
  1093.   FUNCTION : MODI_quickprop
  1094.  
  1095.   PURPOSE  : modifies the network at the end of each epoch
  1096.   RETURNS  : 
  1097.   NOTES    :
  1098.  
  1099.   UPDATE   : 06.11.1993 by Guenter Mamier
  1100. ******************************************************************************/
  1101. static void  MODI_quickprop(float learn_parameter, float max_factor, 
  1102.                 float decay)
  1103.  /* learning parameter */
  1104.  /* maximal grow factor of weights */
  1105.  /* decay factor */
  1106.  
  1107. {
  1108.     double          deltaw;    /* actual weight (bias) change */
  1109.     float           shfac;    /* shrink factor */
  1110.     register struct Link *link_ptr;
  1111.     register struct Site *site_ptr;
  1112.     register struct Unit *unit_ptr;
  1113.     TopoPtrArray    topo_ptr;
  1114.     bool            hidden_units;
  1115.  
  1116.  
  1117.     /* maximal grow factor of weights is max_factor  */
  1118.     shfac = max_factor / (1.0 + max_factor);
  1119.  
  1120.     topo_ptr = topo_ptr_array + (NoOfInputUnits + 1);
  1121.     hidden_units = TRUE;
  1122.  
  1123.     /* calculate hidden and output units only  */
  1124.     do {
  1125.     if ((unit_ptr = *++topo_ptr) == NULL) {
  1126.         if (!hidden_units)
  1127.         break;        /* end of topologic pointer array reached  */
  1128.         unit_ptr = *++topo_ptr;    /* skip NULL pointer  */
  1129.         hidden_units = FALSE;
  1130.     }
  1131.     if (IS_SPECIAL_UNIT(unit_ptr)) {
  1132.         unit_ptr->value_a = 
  1133.         unit_ptr->value_b = 
  1134.         unit_ptr->value_c = 0.0;
  1135.         if (UNIT_HAS_DIRECT_INPUTS(unit_ptr)) {/* unit has direct links */
  1136.         FOR_ALL_LINKS(unit_ptr, link_ptr) {
  1137.             link_ptr->value_a = 
  1138.             link_ptr->value_b = 
  1139.             link_ptr->value_c = 0.0;
  1140.         }
  1141.         } else {        /* the unit has sites  */
  1142.         FOR_ALL_SITES_AND_LINKS(unit_ptr, site_ptr, link_ptr) {
  1143.             link_ptr->value_a = 
  1144.             link_ptr->value_b = 
  1145.             link_ptr->value_c = 0.0;
  1146.         }
  1147.         }
  1148.     } else {
  1149.         deltaw = 0.0;    /* adjust bias like a weight  */
  1150.         if (unit_ptr->value_a > 0.0) { /* previous step was positive  */
  1151.         if (unit_ptr->value_c < 0.0)
  1152.             /* same direction,i.e. slope, value_b have same sign  */
  1153.             deltaw += learn_parameter * (-unit_ptr->value_c);
  1154.  
  1155.         if (unit_ptr->value_c <= shfac * unit_ptr->value_b)
  1156.             /* maximal positive step  */
  1157.             deltaw += max_factor * unit_ptr->value_a;
  1158.         else
  1159.             /* littler positive step squared approximation  */
  1160.             deltaw += unit_ptr->value_c / 
  1161.                   (unit_ptr->value_b - unit_ptr->value_c)
  1162.                   * unit_ptr->value_a;
  1163.         } else if (unit_ptr->value_a < 0.0) {    /* previous step was
  1164.                                negative  */
  1165.         if (unit_ptr->value_c > 0.0)
  1166.             /* same direction,i.e. slope, prevslope have same sign  */
  1167.             deltaw += learn_parameter * (-unit_ptr->value_c);
  1168.  
  1169.         if (unit_ptr->value_c >= shfac * unit_ptr->value_b)
  1170.             /* maximal negative step  */
  1171.             deltaw += max_factor * unit_ptr->value_a;
  1172.         else
  1173.             /* littler negative step squared approximation */
  1174.             deltaw += unit_ptr->value_c / 
  1175.                   (unit_ptr->value_b - unit_ptr->value_c)
  1176.                   * unit_ptr->value_a;
  1177.         } else
  1178.         /* previous step was 0.0  */
  1179.         /* start of learning process with BP  */
  1180.         deltaw += learn_parameter * (-unit_ptr->value_c);
  1181.  
  1182.         unit_ptr->bias += deltaw;    /* new bias */
  1183.         unit_ptr->value_a = deltaw;    /* bias change */
  1184.         unit_ptr->value_b = unit_ptr->value_c;    /* previous slope */
  1185.         unit_ptr->value_c = decay * unit_ptr->bias;    /* set new slope  */
  1186.  
  1187.         /* adjust links */
  1188.         if (UNIT_HAS_DIRECT_INPUTS(unit_ptr)) {/* unit has direct links */
  1189.         FOR_ALL_LINKS(unit_ptr, link_ptr) {
  1190.             deltaw = 0.0;
  1191.  
  1192.             if (link_ptr->value_a > 0.0) { /* prev step was positive */
  1193.             if (link_ptr->value_c < 0.0)
  1194.                 /* same direction,i.e. slope, prevslope have same
  1195.                    sign  */
  1196.                 deltaw += learn_parameter * (-link_ptr->value_c);
  1197.  
  1198.             if (link_ptr->value_c <= shfac * link_ptr->value_b)
  1199.                 /* maximal positive step  */
  1200.                 deltaw += max_factor * link_ptr->value_a;
  1201.             else
  1202.                 deltaw += link_ptr->value_c / 
  1203.                       (link_ptr->value_b - link_ptr->value_c)
  1204.                       * link_ptr->value_a;
  1205.             } else if (link_ptr->value_a < 0.0) {    
  1206.             /* previous step was negative */
  1207.             if (link_ptr->value_c > 0.0)
  1208.                 /* same direction,i.e. slope, prevslope have same
  1209.                    sign */
  1210.                 deltaw += learn_parameter * (-link_ptr->value_c);
  1211.  
  1212.             if (link_ptr->value_c >= shfac * link_ptr->value_b)
  1213.                 /* maximal negative step  */
  1214.                 deltaw += max_factor * link_ptr->value_a;
  1215.             else
  1216.                 deltaw += link_ptr->value_c / 
  1217.                       (link_ptr->value_b - link_ptr->value_c)
  1218.                       * link_ptr->value_a;
  1219.             } else    /* previous step was 0.0  */
  1220.             /* start of learning process with BP  */
  1221.             deltaw += learn_parameter * (-link_ptr->value_c);
  1222.  
  1223.             link_ptr->weight += deltaw;    /* new weight */
  1224.             link_ptr->value_a = deltaw;    /* weight change */
  1225.             link_ptr->value_b = link_ptr->value_c;  /* previous slope */
  1226.             /* set new slope  */
  1227.             link_ptr->value_c = decay * link_ptr->weight;
  1228.         }        /* for links  */
  1229.         } else {        /* the unit has sites  */
  1230.         FOR_ALL_SITES_AND_LINKS(unit_ptr, site_ptr, link_ptr) {
  1231.             deltaw = 0.0;
  1232.             if (link_ptr->value_a > 0.0) {    /* previous step was
  1233.                                positive  */
  1234.             if (link_ptr->value_c < 0.0)
  1235.                 /* same direction,i.e. slope, prevslope have same
  1236.                    sign  */
  1237.                 deltaw += learn_parameter * (-link_ptr->value_c);
  1238.  
  1239.             if (link_ptr->value_c <= shfac * link_ptr->value_b)
  1240.                 /* maximal positive step  */
  1241.                 deltaw += max_factor * link_ptr->value_a;
  1242.             else
  1243.                 /* littler positive step squared approximation  */
  1244.                 deltaw += link_ptr->value_c / 
  1245.                       (link_ptr->value_b - link_ptr->value_c)
  1246.                        * link_ptr->value_a;
  1247.             } else if (link_ptr->value_a < 0.0) {    
  1248.             /* previous step was negative  */
  1249.             if (link_ptr->value_c > 0.0)
  1250.                 /* same direction,i.e. slope, prevslope have same
  1251.                    sign  */
  1252.                 deltaw += learn_parameter * (-link_ptr->value_c);
  1253.  
  1254.             if (link_ptr->value_c >= shfac * link_ptr->value_b)
  1255.                 /* maximal negative step  */
  1256.                 deltaw += max_factor * link_ptr->value_a;
  1257.             else
  1258.                 deltaw += link_ptr->value_c / 
  1259.                       (link_ptr->value_b - link_ptr->value_c)
  1260.                       * link_ptr->value_a;
  1261.             } else    /* previous step was 0.0  */
  1262.             /* start of learning process with BP  */
  1263.             deltaw += learn_parameter * (-link_ptr->value_c);
  1264.  
  1265.             link_ptr->weight += deltaw;    /* new weight */
  1266.             link_ptr->value_a = deltaw;    /* weight change */
  1267.             link_ptr->value_b = link_ptr->value_c; /* previous slope */
  1268.             /* set new slope */
  1269.             link_ptr->value_c = decay * link_ptr->weight;
  1270.         }
  1271.         }
  1272.     }
  1273.     }                /* for units  */
  1274.     while (TRUE);
  1275.  
  1276. }
  1277.  
  1278.  
  1279. /*****************************************************************************
  1280.   FUNCTION : LEARN_quickprop
  1281.  
  1282.   PURPOSE  : Quickprop learning function
  1283.   RETURNS  : kernel error code
  1284.   NOTES    : Input Parameters:   1 : learning parameter
  1285.                                  2 : max factor (of the net after every epoch)
  1286.                                  3 : decay
  1287.                                  4 : delta max
  1288.  
  1289.              Output Parameters:  1 : error of the network (sum of all cycles)
  1290.  
  1291.  
  1292.   UPDATE   : 06.11.1993 by Guenter Mamier
  1293. ******************************************************************************/
  1294. krui_err LEARN_quickprop(int start_pattern, int end_pattern, 
  1295.              float *parameterInArray, int NoOfInParams, 
  1296.              float **parameterOutArray, int *NoOfOutParams)
  1297. {
  1298.     static float OutParameter[1]; /* OutParameter[0] stores the learning error*/
  1299.     int          i, pattern_no, sub_pat_no, ret_code;
  1300.  
  1301.  
  1302.     if (NoOfInParams < 1)    /* ###  have to be changed  (must be 3)  #### */
  1303.     return (KRERR_PARAMETERS);    /* not enough input parameters  */
  1304.  
  1305.     *NoOfOutParams = 1;        /* one return value is available (the
  1306.                    learning error) */
  1307.  
  1308.     *parameterOutArray = OutParameter;    /* set output parameter reference  */
  1309.     ret_code = KRERR_NO_ERROR;    /* reset return code  */
  1310.  
  1311.     if (NetModified || (TopoSortID != TOPOLOGICAL_FF)) {    
  1312.     /* Net has been modified or topologic array isn't initialized */
  1313.     /* check the topology of the network  */
  1314.     ret_code = kr_topoCheck();
  1315.     if (ret_code < KRERR_NO_ERROR)
  1316.         return (ret_code);    /* an error has occured  */
  1317.     if (ret_code < 2)
  1318.         return (KRERR_FEW_LAYERS);    /* the network has less then 2 layers */
  1319.  
  1320.     /* count the no. of I/O units and check the patterns  */
  1321.     ret_code = kr_IOCheck();
  1322.     if (ret_code < KRERR_NO_ERROR)
  1323.         return (ret_code);
  1324.  
  1325.     /* sort units by topology and by topologic type  */
  1326.     ret_code = kr_topoSort(TOPOLOGICAL_FF);
  1327.     if ((ret_code != KRERR_NO_ERROR) && (ret_code != KRERR_DEAD_UNITS))
  1328.         return (ret_code);
  1329.  
  1330.     NetModified = FALSE;
  1331.     }
  1332.     if (NetInitialize || LearnFuncHasChanged) {    /* Net has been modified or
  1333.                            initialized, initialize
  1334.                            backprop now  */
  1335.     ret_code = initializeQuickprop();
  1336.     if (ret_code != KRERR_NO_ERROR)
  1337.         return (ret_code);
  1338.     }
  1339.  
  1340.  
  1341.     /* compute the necessary sub patterns */
  1342.  
  1343.     KernelErrorCode = kr_initSubPatternOrder(start_pattern,end_pattern);
  1344.     if(KernelErrorCode != KRERR_NO_ERROR)
  1345.     return (KernelErrorCode);
  1346.  
  1347.  
  1348.     NET_ERROR(OutParameter) = 0.0;    /* reset network error value  */
  1349.  
  1350.     while(kr_getSubPatternByOrder(&pattern_no,&sub_pat_no)){
  1351.  
  1352.     propagateNetForward(pattern_no,sub_pat_no);   /* Forward propagation */
  1353.  
  1354.     /* backward propagation and summation of gradient  */
  1355.     NET_ERROR(OutParameter) +=
  1356.         propagateNetBackwardQuickprop(pattern_no,sub_pat_no,
  1357.                       LEARN_PARAM4(parameterInArray));
  1358.     }
  1359.  
  1360.     /* modificate links and bias  */
  1361.     MODI_quickprop(LEARN_PARAM1(parameterInArray),
  1362.            LEARN_PARAM2(parameterInArray),
  1363.            LEARN_PARAM3(parameterInArray));
  1364.  
  1365.     return (ret_code);
  1366. }
  1367.  
  1368.  
  1369.  
  1370. /*****************************************************************************
  1371.  *****************************************************************************
  1372.  
  1373.   GROUP        : Counterpropagation learning function
  1374.  
  1375.   AUTHOR       :
  1376.   DATE         : 01.01.1990
  1377.   LAST CHANGE  : 05.11.1993
  1378.  
  1379.              Copyright (c) 1990-1994  SNNS Group, IPVR, Univ. Stuttgart, FRG
  1380.              
  1381. ******************************************************************************
  1382. ******************************************************************************/
  1383.  
  1384. /*****************************************************************************
  1385.   FUNCTION : initializeCPN
  1386.  
  1387.   PURPOSE  : Counterpropagation initialisation
  1388.   RETURNS  : kernel error code
  1389.   NOTES    :
  1390.  
  1391.   UPDATE   : 06.11.1993 by Guenter Mamier
  1392. ******************************************************************************/
  1393. static krui_err initializeCPN(void)
  1394. {
  1395.     register struct Unit *unit_ptr;
  1396.  
  1397.  
  1398.     NoOfLearnedPatterns = 0;
  1399.  
  1400.     /* set unit's bias to zero  */
  1401.     FOR_ALL_UNITS(unit_ptr)
  1402.     if ((unit_ptr->flags & UFLAG_IN_USE) == UFLAG_IN_USE)
  1403.     /* unit is in use  */
  1404.     unit_ptr->bias = (FlintType) 0;
  1405.  
  1406.     return (KRERR_NO_ERROR);
  1407. }
  1408.  
  1409.  
  1410. /*****************************************************************************
  1411.   FUNCTION : normalize_weight
  1412.  
  1413.   PURPOSE  : Counterpropagation initialisation
  1414.   RETURNS  : 
  1415.   NOTES    :
  1416.  
  1417.   UPDATE   : 06.11.1993 by Guenter Mamier
  1418. ******************************************************************************/
  1419. static void normalize_weight(struct Unit * winner_ptr, float sum)
  1420. {
  1421.     register struct Site *site_ptr;
  1422.     register struct Link *link_ptr;
  1423.     register float  amount;
  1424.  
  1425.  
  1426.     amount = 1.0 / sqrt(sum);
  1427.  
  1428.     /* not necessary to see whether this is a special unit */
  1429.  
  1430.     if (winner_ptr->flags & UFLAG_SITES)
  1431.     /* the unit has sites */
  1432.     FOR_ALL_SITES_AND_LINKS(winner_ptr, site_ptr, link_ptr)
  1433.         link_ptr->weight = link_ptr->weight * amount;
  1434.     else
  1435.     /* the unit has direct links */
  1436.     FOR_ALL_LINKS(winner_ptr, link_ptr)
  1437.         link_ptr->weight = link_ptr->weight * amount;
  1438. }
  1439.  
  1440.  
  1441. /*****************************************************************************
  1442.   FUNCTION : normalize_inputvector 
  1443.  
  1444.   PURPOSE  :
  1445.   RETURNS  : 
  1446.   NOTES    :
  1447.  
  1448.   UPDATE   : 06.11.1993 by Guenter Mamier
  1449. ******************************************************************************/
  1450. static void normalize_inputvector(float sum)
  1451. {
  1452.     register struct Unit *unit_ptr;
  1453.     register float  amount;
  1454.  
  1455.  
  1456.     amount = 1.0 / sqrt(sum);
  1457.  
  1458.     FOR_ALL_UNITS(unit_ptr)
  1459.     if (IS_INPUT_UNIT(unit_ptr) && UNIT_IN_USE(unit_ptr))
  1460.     /* this is a input unit */
  1461.     unit_ptr->Out.output = unit_ptr->Out.output * amount;
  1462. }
  1463.  
  1464.  
  1465.  
  1466. /*****************************************************************************
  1467.   FUNCTION : propagateNet_CPN
  1468.  
  1469.   PURPOSE  : forward pass of counterprop
  1470.   RETURNS  : 
  1471.   NOTES    :
  1472.  
  1473.   UPDATE   : 06.11.1993 by Guenter Mamier
  1474. ******************************************************************************/
  1475. static float propagateNet_CPN(int pattern_no, int sub_pat_no, float alpha,
  1476.                   float beta, float threshold)
  1477. {
  1478.     register struct Link *link_ptr;
  1479.     register struct Site *site_ptr;
  1480.     register struct Unit *unit_ptr;
  1481.     register struct Unit *winner_ptr;
  1482.     register Patterns in_pat, out_pat;
  1483.     float           maximum, sum_error, devit, learn_error, sum;
  1484.     float           unit_ptr_net;
  1485.     float           noOfPatterns_mul_NoHiddenUnits;
  1486.     register TopoPtrArray topo_ptr;
  1487.  
  1488.     /* calculate the activation and the output values         */
  1489.     /* of the input units (Input Layer)                       */
  1490.  
  1491.     noOfPatterns_mul_NoHiddenUnits = (float) NoOfLearnedPatterns *
  1492.                                  (float) NoOfHiddenUnits;
  1493.  
  1494.     sum = 0.0;
  1495.  
  1496.     /* calculate startaddress for input pattern array  */
  1497.     in_pat = kr_getSubPatData(pattern_no,sub_pat_no,INPUT,NULL);
  1498.  
  1499.  
  1500.     topo_ptr = topo_ptr_array;
  1501.  
  1502.     /* copy pattern into input unit's activation and calculate output of the
  1503.        input units */
  1504.     while ((unit_ptr = *++topo_ptr) != NULL) {    
  1505.     
  1506.     /* topo_ptr points to the unit stuctures (sorted by: input-, hidden- 
  1507.        and output-units, separated with NULL pointers) */
  1508.     sum += *in_pat * *in_pat;
  1509.  
  1510.     if (unit_ptr->out_func == OUT_IDENTITY)
  1511.         /* identity output function: there is no need to call the output
  1512.            function  */
  1513.         unit_ptr->Out.output = unit_ptr->act = *in_pat++;
  1514.     else
  1515.         /* no identity output function: calculate unit's output also  */
  1516.         unit_ptr->Out.output = 
  1517.         (*unit_ptr->out_func) (unit_ptr->act = *in_pat++);
  1518.     }
  1519.  
  1520.     if (sum != 0.0)
  1521.     /* normalize the inputvector */
  1522.     normalize_inputvector(sum);
  1523.  
  1524.  
  1525.     /* propagate Kohonen Layer   */
  1526.  
  1527.     /* calculate the activation and the output values         */
  1528.     /* of the hidden units (Kohonen Layer)                    */
  1529.  
  1530.  
  1531.     winner_ptr = NULL;
  1532.     maximum = -1.0e30;        /* contains the maximum of the activations */
  1533.  
  1534.     /* popagate hidden units  */
  1535.     while ((unit_ptr = *++topo_ptr) != NULL) {    /* topo_ptr points to a
  1536.                            (topological sorted) unit
  1537.                            stucture */
  1538.     unit_ptr_net = 0.0;
  1539.     if (UNIT_HAS_DIRECT_INPUTS(unit_ptr)) {    /* the unit has direct links */
  1540.         FOR_ALL_LINKS(unit_ptr, link_ptr)
  1541.         unit_ptr_net += (link_ptr->weight * link_ptr->to->Out.output);
  1542.     } else {        /* the unit has sites     */
  1543.         FOR_ALL_SITES_AND_LINKS(unit_ptr, site_ptr, link_ptr)
  1544.         unit_ptr_net += (link_ptr->weight * link_ptr->to->Out.output);
  1545.     }
  1546.  
  1547.     if (unit_ptr->bias >= noOfPatterns_mul_NoHiddenUnits)
  1548.         unit_ptr_net -= threshold;
  1549.  
  1550.     if (maximum < unit_ptr_net) {    /* determine winner unit  */
  1551.         winner_ptr = unit_ptr;
  1552.         maximum = unit_ptr_net;
  1553.     }
  1554.     /* reset output and activation of hidden units  */
  1555.     unit_ptr->Out.output = unit_ptr->act = (FlintType) 0;
  1556.     }
  1557.  
  1558.  
  1559.     /* the competitive winner is chosen                */
  1560.  
  1561.     winner_ptr->Out.output = winner_ptr->act = (FlintType) 1;
  1562.     winner_ptr->bias++;
  1563.  
  1564.  
  1565.  
  1566.     /* Training the Kohonen Layer                   
  1567.        
  1568.        Only the weights of links that go to the winning unit are adjusted, 
  1569.        the others remain the same. The incoming weights to the competitive 
  1570.        unit are adapted as follows:
  1571.          
  1572.        weight(new) = weight(old) + eta * (output - weight(old))  
  1573.          
  1574.        where eta is the learning constant (0<eta<=1.0)             
  1575.        and output is the output of the input unit                  
  1576.     */ 
  1577.  
  1578.  
  1579.     if (!IS_SPECIAL_UNIT(winner_ptr)) {
  1580.     sum = 0.0;
  1581.     if (winner_ptr->flags & UFLAG_DLINKS) {    /* the winner unit has direct
  1582.                            links  */
  1583.         FOR_ALL_LINKS(winner_ptr, link_ptr) {
  1584.         devit = link_ptr->to->Out.output - link_ptr->weight;
  1585.         learn_error = alpha * devit;
  1586.         link_ptr->weight += learn_error;
  1587.         /* this is needed for the normalization of the weight_vector */
  1588.         sum += link_ptr->weight * link_ptr->weight;
  1589.         }
  1590.     } else {        /* the winner unit has sites  */
  1591.         FOR_ALL_SITES_AND_LINKS(winner_ptr, site_ptr, link_ptr) {
  1592.         devit = link_ptr->to->Out.output - link_ptr->weight;
  1593.         learn_error = alpha * devit;
  1594.         link_ptr->weight += learn_error;
  1595.         /* this is needed for the normalization of the weight_vector */
  1596.         sum += link_ptr->weight * link_ptr->weight;
  1597.         }
  1598.     }
  1599.     if (sum != 0.0)
  1600.         normalize_weight(winner_ptr, sum);
  1601.     }
  1602.  
  1603.  
  1604.     /* propagate Grossberg Layer                      */
  1605.     /* Training the Grossberg Layer                   */
  1606.     /* Adaptation of the Grossberg Layer weights is done by the    */
  1607.     /* Widrow-Hoff rule:                                           */
  1608.  
  1609.     /* weight(new) = weight(old) + beta * (target output - output) */
  1610.  
  1611.     /* for all weights connected with the winning unit of the      */
  1612.     /* Kohonen Layers                                              */
  1613.  
  1614.  
  1615.     /* calculate address of the output pattern */
  1616.     out_pat = kr_getSubPatData(pattern_no,sub_pat_no,OUTPUT,NULL);
  1617.  
  1618.  
  1619.     sum_error = 0.0;
  1620.  
  1621.     /* popagate output units  */
  1622.     while ((unit_ptr = *++topo_ptr) != NULL) {    /* topo_ptr points to a
  1623.                            (topological sorted) unit
  1624.                            stucture */
  1625.  
  1626.     /* calculate the activation and the output values         */
  1627.     /* of the output units (Grossberg Layer)                  */
  1628.  
  1629.     /* the activation function is the identity function (weighted sum)
  1630.        and identity output function */
  1631.     unit_ptr->Out.output = unit_ptr->act = (*unit_ptr->act_func) (unit_ptr);
  1632.  
  1633.     devit = *out_pat++ - unit_ptr->Out.output;    /* calculate devitation */
  1634.     sum_error += devit * devit;
  1635.     learn_error = beta * devit;
  1636.  
  1637.     if (!IS_SPECIAL_UNIT(unit_ptr)) {
  1638.         if (UNIT_HAS_DIRECT_INPUTS(unit_ptr)){ /* unit has direct links */
  1639.         FOR_ALL_LINKS(unit_ptr, link_ptr)
  1640.             if (link_ptr->to == winner_ptr) {
  1641.             /* link to the winning unit of the Kohonen Layer */
  1642.             link_ptr->weight += learn_error;
  1643.             break;
  1644.             }
  1645.         } else {        /* the unit has sites */
  1646.         FOR_ALL_SITES_AND_LINKS(unit_ptr, site_ptr, link_ptr)
  1647.             if (link_ptr->to == winner_ptr) {
  1648.             /* link to the winning unit of the Kohonen Layer */
  1649.             link_ptr->weight += learn_error;
  1650.             break;
  1651.             }
  1652.         }
  1653.     }
  1654.     }
  1655.  
  1656.     return (sum_error);
  1657. }
  1658.  
  1659.  
  1660.  
  1661. /*****************************************************************************
  1662.   FUNCTION : LEARN_CPN
  1663.  
  1664.   PURPOSE  : main function for counterpropagtion
  1665.   RETURNS  : 
  1666.   NOTES    :
  1667.  
  1668.   UPDATE   : 06.11.1993 by Guenter Mamier
  1669. ******************************************************************************/
  1670. krui_err  LEARN_CPN(int start_pattern, int end_pattern, 
  1671.             float *parameterInArray, int NoOfInParams, 
  1672.             float **parameterOutArray, int *NoOfOutParams)
  1673. {
  1674.     static float    OutParameter[1];    /* OutParameter[0] stores the
  1675.                        learning error  */
  1676.     int             ret_code, i, pattern_no, sub_pat_no;
  1677.  
  1678.  
  1679.     if (NoOfInParams < 1)    /* have to be changed (must be 3) */
  1680.     return (KRERR_PARAMETERS);    /* Not enough input parameters  */
  1681.  
  1682.     *NoOfOutParams = 1;        /* one return value is available (the
  1683.                    learning error) */
  1684.     *parameterOutArray = OutParameter;    /* set output parameter reference  */
  1685.     ret_code = KRERR_NO_ERROR;    /* clear return code  */
  1686.  
  1687.  
  1688.     if (NetModified || (TopoSortID != TOPOLOGIC_TYPE)) {    
  1689.     /* Net has been modified  or topologic array isn't initialized */
  1690.     /* check the topology of the network  */
  1691.     ret_code = kr_topoCheck();
  1692.     if (ret_code < KRERR_NO_ERROR)
  1693.         return (ret_code);    /* an error has occured  */
  1694.     if (ret_code != 3)
  1695.         return (KRERR_FEW_LAYERS);    /* the network has less then 2 layers */
  1696.  
  1697.     /* count the no. of I/O units and check the patterns  */
  1698.     ret_code = kr_IOCheck();
  1699.     if (ret_code < KRERR_NO_ERROR)
  1700.         return (ret_code);
  1701.  
  1702.     /* sort units by topology and by topologic type  */
  1703.     ret_code = kr_topoSort(TOPOLOGIC_TYPE);
  1704.     if ((ret_code != KRERR_NO_ERROR) && (ret_code != KRERR_DEAD_UNITS))
  1705.         return (ret_code);
  1706.  
  1707.     NetModified = FALSE;
  1708.     }
  1709.     if (NetInitialize || LearnFuncHasChanged) {    /* Net has been modified or
  1710.                            initialized, initialize
  1711.                            backprop now  */
  1712.     ret_code = initializeCPN();
  1713.     if (ret_code != KRERR_NO_ERROR)
  1714.         return (ret_code);
  1715.     }
  1716.  
  1717.  
  1718.     /* compute the necessary sub patterns */
  1719.  
  1720.     KernelErrorCode = kr_initSubPatternOrder(start_pattern,end_pattern);
  1721.     if(KernelErrorCode != KRERR_NO_ERROR)
  1722.     return (KernelErrorCode);
  1723.  
  1724.  
  1725.     NET_ERROR(OutParameter) = 0.0;    /* reset network error value  */
  1726.  
  1727.     while(kr_getSubPatternByOrder(&pattern_no,&sub_pat_no)){
  1728.  
  1729.     NoOfLearnedPatterns++;
  1730.     NET_ERROR(OutParameter) 
  1731.         += propagateNet_CPN(pattern_no,sub_pat_no,
  1732.                 LEARN_PARAM1(parameterInArray),
  1733.                 LEARN_PARAM2(parameterInArray),
  1734.                 LEARN_PARAM3(parameterInArray));
  1735.     }
  1736.  
  1737.     return (ret_code);
  1738. }
  1739.  
  1740.  
  1741.  
  1742.  
  1743. /*****************************************************************************
  1744.  *****************************************************************************
  1745.  
  1746.   GROUP        : Back-Percolation Learning Function
  1747.  
  1748.   AUTHOR       : Artemis Hatzigeorgiou  Algorithm by Mark Jurik
  1749.   DATE         : 01.01.1992
  1750.   LAST CHANGE  : 06.11.1993
  1751.  
  1752.              Copyright (c) 1990-1994  SNNS Group, IPVR, Univ. Stuttgart, FRG
  1753.              
  1754. ******************************************************************************
  1755. ******************************************************************************/
  1756.  
  1757. /*****************************************************************************
  1758.   FUNCTION : propagateNetForward_perc
  1759.  
  1760.   PURPOSE  : topological forward propagation
  1761.   RETURNS  : 
  1762.   NOTES    :
  1763.  
  1764.   UPDATE   : 06.11.1993 by Guenter Mamier
  1765. ******************************************************************************/
  1766. static void propagateNetForward_perc(int pattern_no, int sub_pat_no)
  1767. {
  1768.     register struct Unit *unit_ptr;
  1769.     register Patterns in_pat;
  1770.     register TopoPtrArray topo_ptr;
  1771.  
  1772.     /* calculate startaddress for input pattern array  */
  1773.     in_pat = kr_getSubPatData(pattern_no,sub_pat_no,INPUT,NULL);
  1774.  
  1775.     topo_ptr = topo_ptr_array;
  1776.  
  1777.     /* copy pattern into input unit's activation and calculate output of the
  1778.        input units */
  1779.     while ((unit_ptr = *++topo_ptr) != NULL) {    /* topo_ptr points to a
  1780.                            (topological sorted) unit
  1781.                            stucture (input units
  1782.                            first)  */
  1783.     if (unit_ptr->out_func == OUT_IDENTITY)
  1784.         /* identity output function: there is no need to call the output
  1785.            function  */
  1786.         unit_ptr->Out.output = unit_ptr->act = *in_pat++;
  1787.     else
  1788.         /* no identity output function: calculate unit's output also  */
  1789.         unit_ptr->Out.output = 
  1790.         (*unit_ptr->out_func) (unit_ptr->act = *in_pat++);
  1791.     }
  1792.  
  1793.     /* popagate hidden units  */
  1794.     while ((unit_ptr = *++topo_ptr) != NULL) {    /* topo_ptr points to a
  1795.                            (topological sorted) unit
  1796.                            stucture */
  1797.     /* clear values  */
  1798.     unit_ptr->Aux.flint_no = 0.0;
  1799.     unit_ptr->value_a = 0.0;
  1800.     unit_ptr->value_b = 0.000001;
  1801.  
  1802.     /* calculate the activation value of the unit: call the activation
  1803.        function if needed  */
  1804.     unit_ptr->act = (*unit_ptr->act_func) (unit_ptr);
  1805.  
  1806.     if (unit_ptr->out_func == OUT_IDENTITY)
  1807.         /* identity output function: there is no need to call the output
  1808.            function  */
  1809.         unit_ptr->Out.output = unit_ptr->act;
  1810.     else
  1811.         /* no identity output function: calculate unit's output also  */
  1812.         unit_ptr->Out.output = (*unit_ptr->out_func) (unit_ptr->act);
  1813.     }
  1814.  
  1815.     /* popagate output units  */
  1816.     while ((unit_ptr = *++topo_ptr) != NULL) {    /* topo_ptr points to a
  1817.                            (topological sorted) unit
  1818.                            stucture */
  1819.     /* clear values  */
  1820.     unit_ptr->Aux.flint_no = 0.0;
  1821.     unit_ptr->value_a = 0.0;
  1822.     unit_ptr->value_b = 0.000001;
  1823.  
  1824.     /* calculate the activation value of the unit: call the activation
  1825.        function if needed  */
  1826.     unit_ptr->act = (*unit_ptr->act_func) (unit_ptr);
  1827.  
  1828.     if (unit_ptr->out_func == OUT_IDENTITY)
  1829.         /* identity output function: there is no need to call the output
  1830.            function  */
  1831.         unit_ptr->Out.output = unit_ptr->act;
  1832.     else
  1833.         /* no identity output function: calculate unit's output also  */
  1834.         unit_ptr->Out.output = (*unit_ptr->out_func) (unit_ptr->act);
  1835.     }
  1836. }
  1837.  
  1838.  
  1839. /*****************************************************************************
  1840.   FUNCTION : propagateNetBackward_perc
  1841.  
  1842.   PURPOSE  :topological backward propagation
  1843.   RETURNS  : network error
  1844.   NOTES    :
  1845.  
  1846.   UPDATE   : 07.02.1994 by Sven Doering
  1847. ******************************************************************************/
  1848. static float propagateNetBackward_perc(int pattern_no, int sub_pat_no,
  1849.                        float learn_parameter,
  1850.                        float delta_max, float *perc_error)
  1851. {
  1852.     register struct Link *link_ptr;
  1853.     register struct Unit *unit_ptr;
  1854.     register Patterns out_pat;
  1855.     register float  error, sum_error, eta, devit;
  1856.     register TopoPtrArray topo_ptr;
  1857.     register float  norm, delta_sig_normaliser, message_weight;
  1858.     register float  act_err, normalised_error, scaled_error, 
  1859.                     delta_weight_normaliser;
  1860.     register float  der = 0.0;
  1861.     register float  tmp;    
  1862.     register int    is_special;
  1863.     int size;
  1864.  
  1865.     sum_error = 0.0;        /* reset network error  */
  1866.     eta = learn_parameter;    /* store learn_parameter in CPU register  */
  1867.  
  1868.     /* calculate address of the output pattern (with number pattern_no + 1)  */
  1869.     out_pat = kr_getSubPatData(pattern_no,sub_pat_no,OUTPUT,&size);
  1870.     out_pat += size;
  1871.  
  1872.     /* add 3 to no_of_topo_units because the topologic array contains 4 NULL
  1873.        pointers  */
  1874.     topo_ptr = topo_ptr_array + (no_of_topo_units + 3);
  1875.  
  1876.     /* calculate output units only  */
  1877.     while ((unit_ptr = *--topo_ptr) != NULL) {
  1878.     devit = *(--out_pat) - unit_ptr->Out.output;    /* calc. devitation */
  1879.  
  1880.     if (fabs(devit) > delta_max) {    /* calc. error for output units     */
  1881.         *perc_error += fabs(devit);
  1882.         error = -2.0 * devit * (unit_ptr->act_deriv_func) (unit_ptr);
  1883.         act_err = devit * eta;
  1884.         sum_error += devit * devit;    /* sum up the error of the network  */
  1885.     } else {        /* set error of output units to zero     */
  1886.         error = 0.0;
  1887.         act_err = 0.000001 * eta;
  1888.         continue;
  1889.     }
  1890.  
  1891.     /* calc. the error for adjusting weights and bias of the predecessor
  1892.        units  */
  1893.  
  1894.     norm = 0.0;
  1895.     delta_sig_normaliser = 0.000001;
  1896.     FOR_ALL_LINKS(unit_ptr, link_ptr) {    /* adjust link weights and
  1897.                            calc. sum of errors of the
  1898.                            predecessor units  */
  1899.         if (IS_HIDDEN_UNIT(link_ptr->to))
  1900.         norm += fabs(link_ptr->weight);
  1901.         delta_sig_normaliser += SQR(link_ptr->to->Out.output);
  1902.     }
  1903.     delta_weight_normaliser = delta_sig_normaliser + 1;
  1904.     norm += delta_sig_normaliser;
  1905.     is_special = IS_SPECIAL_UNIT(unit_ptr);
  1906.     normalised_error = act_err / norm;
  1907.     scaled_error = act_err / delta_weight_normaliser;
  1908.     FOR_ALL_LINKS(unit_ptr, link_ptr) {
  1909.         tmp = link_ptr->weight * error;
  1910.         link_ptr->to->Aux.flint_no += tmp;
  1911.  
  1912.         message_weight = tmp * tmp;
  1913.         if (!is_special) {
  1914.         link_ptr->to->value_a += link_ptr->weight * 
  1915.             normalised_error * message_weight;
  1916.         link_ptr->to->value_b += message_weight;
  1917.         link_ptr->weight += link_ptr->to->Out.output * scaled_error;
  1918.         }
  1919.     }
  1920.  
  1921.  
  1922.     /* adjust bias value  */
  1923.     if (!is_special)
  1924.         unit_ptr->bias += scaled_error;
  1925.     }
  1926.  
  1927.     /* calculate hidden units only  */
  1928.     while ((unit_ptr = *--topo_ptr) != NULL) {
  1929.     der = (unit_ptr->act_deriv_func) (unit_ptr);
  1930.     error = der * unit_ptr->Aux.flint_no;
  1931.     act_err = (unit_ptr->value_a / unit_ptr->value_b) * der;
  1932.  
  1933.     /* calc. the error for adjusting weights and bias of the predecessor
  1934.        units  */
  1935.  
  1936.     norm = 0.0;
  1937.     delta_sig_normaliser = 0.000001;
  1938.     FOR_ALL_LINKS(unit_ptr, link_ptr) {
  1939.         if (IS_HIDDEN_UNIT(link_ptr->to))
  1940.         norm += fabs(link_ptr->weight);
  1941.  
  1942.         delta_sig_normaliser += SQR(link_ptr->to->Out.output);
  1943.     }
  1944.     delta_weight_normaliser = delta_sig_normaliser + 1;
  1945.     norm += delta_sig_normaliser;
  1946.     is_special = IS_SPECIAL_UNIT(unit_ptr);
  1947.     normalised_error = act_err / norm;
  1948.     scaled_error = act_err / delta_weight_normaliser;
  1949.     FOR_ALL_LINKS(unit_ptr, link_ptr) {
  1950.         tmp = link_ptr->weight * error;
  1951.         link_ptr->to->Aux.flint_no += tmp;
  1952.  
  1953.         message_weight = tmp * tmp;
  1954.  
  1955.         if (!is_special) {
  1956.         link_ptr->to->value_a += link_ptr->weight * 
  1957.             normalised_error * message_weight;
  1958.         link_ptr->to->value_b += message_weight;
  1959.         link_ptr->weight += link_ptr->to->Out.output * scaled_error;
  1960.         }
  1961.     }
  1962.  
  1963.  
  1964.     /* adjust bias value  */
  1965.     if (!is_special)
  1966.         unit_ptr->bias += scaled_error;
  1967.     }
  1968.  
  1969.     return (sum_error);        /* return the error of the network */
  1970. }
  1971.  
  1972.  
  1973.  
  1974. /*****************************************************************************
  1975.   FUNCTION : LEARN_perc
  1976.  
  1977.   PURPOSE  : main function for backpercolation
  1978.   RETURNS  : kernel error code
  1979.   NOTES    : Input Parameters:   1 : learning parameter
  1980.                                  2 : delta max
  1981.  
  1982.              Output Parameters:  1 : error of the network (sum of all cycles)
  1983.  
  1984.   UPDATE   : 06.11.1993 by Guenter Mamier
  1985. ******************************************************************************/
  1986. krui_err LEARN_perc(int start_pattern, int end_pattern, 
  1987.                 float *parameterInArray, int NoOfInParams, 
  1988.                 float **parameterOutArray, int *NoOfOutParams)
  1989. {
  1990.     static float    OutParameter[1];    /* OutParameter[0] stores the
  1991.                        learning error  */
  1992.     int             i, ret_code, pattern_no, sub_pat_no;
  1993.     float           p_error, l_error;
  1994.     register struct Unit *unit_ptr;
  1995.  
  1996.     if (NoOfInParams < 1)            /* have to be changed (must be 2)  */
  1997.     return (KRERR_PARAMETERS);    /* Not enough input parameters  */
  1998.  
  1999.     *NoOfOutParams = 1;                /* One return value is available (the
  2000.                            learning error)  */
  2001.     *parameterOutArray = OutParameter;    /* set the output parameter reference */
  2002.     ret_code = KRERR_NO_ERROR;    /* reset return code  */
  2003.  
  2004.     if (NetModified || (TopoSortID != TOPOLOGICAL_FF)) {    
  2005.     /* Net has been modified or topologic array isn't initialized */
  2006.     /* check the topology of the network  */
  2007.     FOR_ALL_UNITS(unit_ptr)
  2008.         if UNIT_HAS_SITES
  2009.         (unit_ptr)
  2010.         return (KRERR_SITES_NO_SUPPORT);
  2011.  
  2012.     ret_code = kr_topoCheck();
  2013.     if (ret_code < KRERR_NO_ERROR)
  2014.         return (ret_code);    /* an error has occured  */
  2015.     if (ret_code < 2)
  2016.         return (KRERR_FEW_LAYERS);    /* the network has less then 2 layers */
  2017.  
  2018.     /* count the no. of I/O units and check the patterns  */
  2019.     ret_code = kr_IOCheck();
  2020.     if (ret_code < KRERR_NO_ERROR)
  2021.         return (ret_code);
  2022.  
  2023.     /* sort units by topology and by topologic type  */
  2024.     ret_code = kr_topoSort(TOPOLOGICAL_FF);
  2025.     if ((ret_code != KRERR_NO_ERROR) && (ret_code != KRERR_DEAD_UNITS))
  2026.         return (ret_code);
  2027.  
  2028.     NetModified = FALSE;
  2029.     }
  2030.     if (NetInitialize || LearnFuncHasChanged) {    /* Net has been modified or
  2031.                            initialized, initialize
  2032.                            backprop now  */
  2033.     if (ret_code != KRERR_NO_ERROR)
  2034.         return (ret_code);
  2035.     parameterInArray[4] = 1.0;
  2036.     }
  2037.  
  2038.  
  2039.     /* compute the necessary sub patterns */
  2040.  
  2041.     KernelErrorCode = kr_initSubPatternOrder(start_pattern,end_pattern);
  2042.     if(KernelErrorCode != KRERR_NO_ERROR)
  2043.     return (KernelErrorCode);
  2044.  
  2045.  
  2046.     NET_ERROR(OutParameter) = 0.0;    /* reset network error value  */
  2047.     p_error = 0.0;
  2048.  
  2049.     while(kr_getSubPatternByOrder(&pattern_no,&sub_pat_no)){
  2050.  
  2051.     propagateNetForward_perc(pattern_no,sub_pat_no);  /* Forward pass */
  2052.  
  2053.     /* Backward propagation  */
  2054.     /* 1st parameter is the learning parameter 2nd parameter is the max.
  2055.        devitation between output pattern and the output of the output
  2056.        unit (delta max) */
  2057.  
  2058.     NET_ERROR(OutParameter) +=
  2059.         propagateNetBackward_perc(pattern_no,sub_pat_no,
  2060.                       LEARN_PARAM1(parameterInArray),
  2061.                       LEARN_PARAM3(parameterInArray), &p_error);
  2062.     }
  2063.  
  2064.     p_error = p_error / (kr_TotalNoOfSubPatPairs()* NoOfOutputUnits);
  2065.  
  2066.     if (p_error < LEARN_PARAM2(parameterInArray)) {
  2067.     p_error = (parameterInArray[4] + p_error) / 2;
  2068.     l_error = exp((parameterInArray[4] - p_error) / 
  2069.               (parameterInArray[4] + p_error));
  2070.     if (l_error <= 0.5)
  2071.         l_error = 0.5;
  2072.     else if (l_error >= 1.05)
  2073.         l_error = 1.05;
  2074.     parameterInArray[0] = parameterInArray[0] * l_error;
  2075.     }
  2076.     parameterInArray[4] = p_error;
  2077.  
  2078.     return (ret_code);
  2079. }
  2080.  
  2081.  
  2082.  
  2083. /*****************************************************************************
  2084.  *****************************************************************************
  2085.  
  2086.   GROUP  : Radial Basis Functions Learning
  2087.  
  2088.   AUTHOR : Michael Vogt
  2089.   Notes  : Use of special entries in links and units with RBFs:
  2090.  
  2091.            for Units in hidden layer:
  2092.        Unit value_a: |X - L|^2  == norm^2 == square of euclidean distance 
  2093.                       between all links and all input units to this unit.
  2094.        Unit value_b: delta_BIAS == sum of all deltas to BIAS during learning
  2095.        Unit value_c: Backpropagated weighted sum of errors in output layer
  2096.  
  2097.        for Units in output layer:
  2098.        Unit value_a: error (y_learn - y_net) during learning current pattern
  2099.        Unit value_b: delta_BIAS == sum of all deltas to BIAS during learning
  2100.  
  2101.        for links between input and hidden layer:
  2102.        Link value_b: delta for this link during learning (link treated as 
  2103.                      vector)
  2104.        Link value_a: Momentum term for this link (last change)
  2105.  
  2106.        for links between hidden and output layer:
  2107.        Link value_b: delta for weight of this link during learning.
  2108.        Link value_a: Momentum term for this link (last change)
  2109.  
  2110.        for links between input and output layer:
  2111.        Link value_b: delta for weight of this link during learning.
  2112.        Link value_a: Momentum term for this link (last change)
  2113.  
  2114.  
  2115.   DATE         : 01.04.1992
  2116.   LAST CHANGE  : 06.11.1993
  2117.  
  2118.              Copyright (c) 1990-1994  SNNS Group, IPVR, Univ. Stuttgart, FRG
  2119.              
  2120. ******************************************************************************
  2121. ******************************************************************************/
  2122.  
  2123.  
  2124. /*****************************************************************************
  2125.   FUNCTION : RbfLearnClean
  2126.  
  2127.   PURPOSE  : Clean all deltas, so that learning can start.
  2128.   RETURNS  : kernel error code
  2129.   NOTES    : Called every time LEARN_RBF is called to be sure that there is 
  2130.              no stuff inside the value_b fields of links and units
  2131.  
  2132.   UPDATE   : 06.11.1993 by Guenter Mamier
  2133. ******************************************************************************/
  2134. krui_err RbfLearnClean(void)
  2135. {
  2136.     register struct Unit *unit_ptr;
  2137.     register struct Link *link_ptr;
  2138.  
  2139.     FOR_ALL_UNITS(unit_ptr) {
  2140.     unit_ptr->value_b = 0.0;
  2141.     FOR_ALL_LINKS(unit_ptr, link_ptr) {
  2142.         link_ptr->value_b = 0.0;
  2143.     }
  2144.     }
  2145.  
  2146.     return KRERR_NO_ERROR;
  2147. }
  2148.  
  2149.  
  2150.  
  2151. /*****************************************************************************
  2152.   FUNCTION : RbfLearnForward
  2153.  
  2154.   PURPOSE  : Forward propagation of current pattern. Calculation of different
  2155.              value_a fields. value_c of hidden units is set to 0.0
  2156.   RETURNS  : kernel error code
  2157.   NOTES    :
  2158.  
  2159.   UPDATE   : 06.11.1993 by Guenter Mamier
  2160. ******************************************************************************/
  2161. krui_err  RbfLearnForward(int pattern_no, int sub_pat_no)
  2162. {
  2163.     register struct Unit *unit_ptr;
  2164.     register Patterns current_in_pattern;
  2165.     register Patterns current_out_pattern;
  2166.     register TopoPtrArray topo_ptr;
  2167.  
  2168.     /* calculate index of current input pattern in Pattern array:     */
  2169.     current_in_pattern = kr_getSubPatData(pattern_no,sub_pat_no,INPUT,NULL);
  2170.  
  2171.     /* activate input units with current patterns and calculate     */
  2172.     /* their output value:                         */
  2173.  
  2174.     topo_ptr = topo_ptr_array;
  2175.     while ((unit_ptr = *(++topo_ptr)) != NULL) {
  2176.     /* go through all input units, set activation and calculate */
  2177.     /* output:                             */
  2178.  
  2179.     unit_ptr->act = *current_in_pattern++;
  2180.     unit_ptr->Out.output = unit_ptr->out_func == OUT_IDENTITY
  2181.         ? unit_ptr->act
  2182.         : (*unit_ptr->out_func) (unit_ptr->act);
  2183.     }
  2184.  
  2185.     /* activate hidden units, by calling the activation function     */
  2186.     /* (has to be a RBF activation function which places norm ^ 2     */
  2187.     /* into value_a of the unit: see trans_f.c: RbfUnitGetNormsqr). */
  2188.     /* The output function is supposed to be OUT_IDENTITY !         */
  2189.     /* (so the output function is never called !)             */
  2190.  
  2191.     while ((unit_ptr = *(++topo_ptr)) != NULL) {
  2192.     unit_ptr->act = unit_ptr->Out.output =
  2193.         (*unit_ptr->act_func) (unit_ptr);
  2194.  
  2195.     unit_ptr->value_c = 0.0;
  2196.     }
  2197.  
  2198.     /* activate output units. Again, the output function is supposed */
  2199.     /* to be OUT_IDENTITY. The calculated output is compared to the */
  2200.     /* current pattern, the error (difference) is calculated and    */
  2201.     /* stored in value_a of the current output unit.         */
  2202.  
  2203.     current_out_pattern = kr_getSubPatData(pattern_no,sub_pat_no,OUTPUT,NULL);
  2204.  
  2205.     while ((unit_ptr = *(++topo_ptr)) != NULL) {
  2206.     unit_ptr->act = unit_ptr->Out.output =
  2207.         (*unit_ptr->act_func) (unit_ptr);
  2208.     unit_ptr->value_a = *current_out_pattern++ - unit_ptr->act;
  2209.     }
  2210.  
  2211.     return KRERR_NO_ERROR;
  2212. }
  2213.  
  2214.  
  2215. #define    RBF_LEARN_CENTER    0x1
  2216. #define RBF_LEARN_BIAS        0x2
  2217. #define RBF_LEARN_WEIGHT    0x4
  2218. #define RBF_LEARN_PAIN        0x8
  2219.  
  2220. /*****************************************************************************
  2221.   FUNCTION : RbfLearnAdjustDelta
  2222.  
  2223.   PURPOSE  : Adjusting of all deltas (value_b fields) by using the current 
  2224.              input pattern (activation of input units) and the stored error 
  2225.          of the output units (value_a). value_c of hidden units is used 
  2226.          too!
  2227.   RETURNS  : 
  2228.   NOTES    :
  2229.  
  2230.   UPDATE   : 06.11.1993 by Guenter Mamier
  2231. ******************************************************************************/
  2232. float RbfLearnAdjustDelta(float para_center, float para_bias, 
  2233.               float para_weight, float para_pain, 
  2234.               float para_momentum, float para_delta_max, 
  2235.               int learn_mask)
  2236. {
  2237.     register struct Unit *curr_unit;    /* current unit         */
  2238.     register struct Link *curr_link;    /* current link         */
  2239.     register struct Unit *source_unit;    /* input unit to link     */
  2240.     register TopoPtrArray topo_ptr;
  2241.     register float  center_delta;    /* delta of centers     */
  2242.     register float  w_error;            /* weighted error of      */
  2243.                                         /* output unit         */
  2244.     register float  w2_error;           /* w_error for special u.*/
  2245.     register float  learn_error;
  2246.  
  2247.     /* start with last unit in output layer:             */
  2248.     topo_ptr = topo_ptr_array + no_of_topo_units + 3;
  2249.  
  2250.     learn_error = 0.0;
  2251.  
  2252.     /* work on the output layer and all links leading to it:     */
  2253.  
  2254.     while ((curr_unit = *(--topo_ptr)) != NULL) {
  2255.     /* go on with next unit if |error| <= delta_max         */
  2256.     if ((float) fabs(curr_unit->value_a) <= para_delta_max)
  2257.         continue;
  2258.  
  2259.     /* error, weighted by the deviation of the activation:     */
  2260.     w2_error = w_error = (curr_unit->value_a) *
  2261.         (*curr_unit->act_deriv_func) (curr_unit);
  2262.  
  2263.     /* sum up the learning error:                 */
  2264.     learn_error += (curr_unit->value_a) * (curr_unit->value_a);
  2265.  
  2266.     if (learn_mask & RBF_LEARN_WEIGHT) {
  2267.         /* sum up all deltas for change of bias:         */
  2268.  
  2269. #ifdef RBF_INCR_LEARNING
  2270.         if (IS_SPECIAL_UNIT(curr_unit)
  2271.         w_error = 0.0;
  2272.         curr_unit->bias += para_weight * w_error;
  2273. #else
  2274.         curr_unit->value_b += w_error;
  2275. #endif
  2276.     }
  2277.     if (learn_mask) {
  2278.         FOR_ALL_LINKS(curr_unit, curr_link) {
  2279.         source_unit = curr_link->to;
  2280.  
  2281.         /* sum up deltas for change of link weight:     */
  2282.  
  2283. #ifdef RBF_INCR_LEARNING
  2284.         curr_link->weight += para_weight * w_error *
  2285.             source_unit->Out.output;
  2286. #else
  2287.         curr_link->value_b += w_error * source_unit->Out.output;
  2288. #endif
  2289.  
  2290.         /* if comming from hidden unit: sum up delta for change */
  2291.         /* of bias of hidden unit:                    */
  2292.         if (IS_HIDDEN_UNIT(source_unit))
  2293.             source_unit->value_c += w2_error * curr_link->weight;
  2294.         }
  2295.     }
  2296.     }
  2297.  
  2298.     /* work on the hidden layer and all links leading to it:     */
  2299.  
  2300.     if (learn_mask & (RBF_LEARN_CENTER | RBF_LEARN_BIAS)) {
  2301.     while ((curr_unit = *(--topo_ptr)) != NULL) {
  2302.         /* now calculate delta for weights of links (centers of the */
  2303.         /* RBF function)                         */
  2304.         curr_unit->Aux.int_no = 2;    /* derivated to norm ^2 */
  2305.         center_delta = curr_unit->value_c *
  2306.         (*curr_unit->act_deriv_func) (curr_unit);
  2307.  
  2308.         if (learn_mask & RBF_LEARN_CENTER) {
  2309. #ifdef RBF_INCR_LEARNING
  2310.         if (IS_SPECIAL_UNIT(curr_unit))
  2311.             center_delta = 0.0;
  2312. #endif
  2313.         FOR_ALL_LINKS(curr_unit, curr_link) {
  2314.  
  2315. #ifdef RBF_INCR_LEARNING
  2316.             curr_link->weight += para_center * center_delta *
  2317.             ((curr_link->to->Out.output) - (curr_link->weight));
  2318. #else
  2319.             curr_link->value_b += center_delta *
  2320.             ((curr_link->to->Out.output) - (curr_link->weight));
  2321. #endif
  2322.         }
  2323.         }
  2324.         /* calculate delta for bias (parameter of RBF function):     */
  2325.         curr_unit->Aux.int_no = 3;    /* derivation to bias!  */
  2326.  
  2327. #ifdef RBF_INCR_LEARNING
  2328.         if (!IS_SPECIAL_UNIT(curr_unit))
  2329.         curr_unit->bias += para_bias * curr_unit->value_c *
  2330.             (*curr_unit->act_deriv_func) (curr_unit);
  2331. #else
  2332.         curr_unit->value_b += curr_unit->value_c *
  2333.         (*curr_unit->act_deriv_func) (curr_unit);
  2334. #endif
  2335.     }
  2336.     }
  2337.     return learn_error;
  2338. }
  2339.  
  2340.  
  2341.  
  2342. /*****************************************************************************
  2343.   FUNCTION : RbfLearnAdjustWeights
  2344.  
  2345.   PURPOSE  : Adjusting of all learnable parameters, depending on collected 
  2346.              deltas and on actual learning parameters.
  2347.   RETURNS  : 
  2348.   NOTES    :
  2349.  
  2350.   UPDATE   : 06.11.1993 by Guenter Mamier
  2351. ******************************************************************************/
  2352. void RbfLearnAdjustWeights(float para_center, float para_bias, 
  2353.                float para_weight, float para_momentum)
  2354. {
  2355.     register struct Unit *curr_unit;    /* current unit         */
  2356.     register struct Link *curr_link;    /* current link         */
  2357.     register TopoPtrArray topo_ptr;
  2358.  
  2359. #ifdef RBF_DELTA_PROT
  2360.     static int      step = 0;    /* current learning step */
  2361.     char            filename[20];    /* Name of prot file     */
  2362.     FILE           *protfile;    /* filepointer         */
  2363.  
  2364. #endif
  2365.  
  2366. #ifdef RBF_DELTA_PROT
  2367.     step++;
  2368.     sprintf(filename, "rbf_%04d.prot", step);
  2369.     protfile = fopen(filename, "w");
  2370.     if (protfile == NULL)
  2371.     fprintf(stderr, "RbfLearnAdjustWeights: Can't open protfile\n");
  2372. #endif
  2373.  
  2374.     /* start with last unit in output layer:             */
  2375.     topo_ptr = topo_ptr_array + no_of_topo_units + 3;
  2376.  
  2377. #ifdef RBF_DELTA_PROT
  2378.     fprintf(protfile, "%s\t\t\n", "h -> o");
  2379. #endif
  2380.  
  2381.     while ((curr_unit = *(--topo_ptr)) != NULL) {
  2382.     if (!IS_SPECIAL_UNIT(curr_unit)) {
  2383.         /* adjust bias of output unit:                       */
  2384.         curr_unit->bias += para_weight * (curr_unit->value_b);
  2385.  
  2386. #ifdef RBF_DELTA_PROT
  2387.         fprintf(protfile, "%13s:\t\n", curr_unit->unit_name);
  2388. #endif
  2389.  
  2390.         /* adjust weights of links leading to this unit:     */
  2391.         FOR_ALL_LINKS(curr_unit, curr_link) {
  2392.  
  2393. #ifdef RBF_DELTA_PROT
  2394.         fprintf(protfile, "%-10.2e\t\n",
  2395.             para_weight * (curr_link->value_b));
  2396. #endif
  2397.  
  2398.         curr_link->weight +=
  2399.             (curr_link->value_a = para_weight * (curr_link->value_b)
  2400.              + para_momentum * curr_link->value_a);
  2401.         }
  2402.     }
  2403.     }
  2404.  
  2405.     /* now adjust weights of hidden layer:             */
  2406.  
  2407. #ifdef RBF_DELTA_PROT
  2408.     fprintf(protfile, "%s\t\t\n", "i -> h");
  2409. #endif
  2410.  
  2411.     while ((curr_unit = *(--topo_ptr)) != NULL) {
  2412.     if (!IS_SPECIAL_UNIT(curr_unit)) {
  2413.         /* adjust bias of hidden unit (parameter of RBF function):     */
  2414.         curr_unit->bias += para_bias * (curr_unit->value_b);
  2415.         if (curr_unit->bias <= 0.0)
  2416.         fprintf(stderr, "Hidden unit bias %f !\n", curr_unit->bias);
  2417.  
  2418. #ifdef RBF_DELTA_PROT
  2419.         fprintf(protfile, "%13s:\t\n", curr_unit->unit_name);
  2420. #endif
  2421.  
  2422.         /* adjust weights of links (centers of RBF functions):     */
  2423.         FOR_ALL_LINKS(curr_unit, curr_link) {
  2424.  
  2425. #ifdef RBF_DELTA_PROT
  2426.         fprintf(protfile, "%-10.2e\t\n",
  2427.             para_center * (curr_link->value_b));
  2428. #endif
  2429.  
  2430.         curr_link->weight +=
  2431.             (curr_link->value_a = para_center * (curr_link->value_b)
  2432.              + para_momentum * curr_link->value_a);
  2433.         }
  2434.     }
  2435.     }
  2436.  
  2437. #ifdef RBF_DELTA_PROT
  2438.     fclose(protfile);
  2439. #endif
  2440. }
  2441.  
  2442.  
  2443.  
  2444. /*****************************************************************************
  2445.   FUNCTION : RbfTopoCheck
  2446.  
  2447.   PURPOSE  : Topological Check for Radial Basis Functions.
  2448.              Also the number of output units is compared to the patterns.
  2449.   RETURNS  : 
  2450.   NOTES    :
  2451.  
  2452.   UPDATE   : 06.11.1993 by Guenter Mamier
  2453. ******************************************************************************/
  2454. krui_err RbfTopoCheck(void)
  2455. {
  2456.     krui_err        ret_code;    /* error return code         */
  2457.  
  2458.     /* Net has been modified or topologic array isn't         */
  2459.     /* initialized. check the topology of the network.         */
  2460.     ret_code = kr_topoCheck();
  2461.     if (ret_code < KRERR_NO_ERROR)
  2462.     return (ret_code);    /* an error has occured */
  2463.     if (ret_code < 2)
  2464.     return (KRERR_NET_DEPTH);    /* the network has less */
  2465.     /* then 2 layers     */
  2466.  
  2467.     /* count the no. of I/O units and check the patterns     */
  2468.     ret_code = kr_IOCheck();
  2469.     if (ret_code < KRERR_NO_ERROR)
  2470.     return (ret_code);
  2471.  
  2472.     /* sort units by topology and by topologic type         */
  2473.     ret_code = kr_topoSort(TOPOLOGICAL_FF);
  2474.  
  2475.     return ret_code;
  2476. }
  2477.  
  2478.  
  2479. /*****************************************************************************
  2480.   FUNCTION : LEARN_RBF
  2481.  
  2482.   PURPOSE  : Learning function for RBF (GRBF) called from kernel.
  2483.   RETURNS  : kernel error code
  2484.   NOTES    : Use of Learning Parameters:
  2485.              LEARN_PARAM1: learning parameter for adjusting centers (links 
  2486.                        between input and hidden layer, treated as vectors)
  2487.              LEARN_PARAM2: learning parameter for adjusting RBF-parameter 
  2488.                        (BIAS of units in hidden layer)
  2489.              LEARN_PARAM3: learning parameter for adjusting weights (all links
  2490.                        to output layer + bias of output units)
  2491.          LEARN_PARAM4: maximum difference between output value and teaching
  2492.                            input which is treated as error 0.0 (delta_max)
  2493.              LEARN_PARAM5: factor for momentum term
  2494.  
  2495.   UPDATE   : 06.11.1993 by Guenter Mamier 
  2496. ******************************************************************************/
  2497. krui_err LEARN_RBF(int start_pattern, int end_pattern, 
  2498.            float *parameterInArray, int NoOfInParams, 
  2499.            float **parameterOutArray, int *NoOfOutParams)
  2500. {
  2501.     static float    OutParameter[1];    /* OutParameter[0] stores     */
  2502.                                         /* the learning error        */
  2503.     int             i, ret_code, pattern_no, sub_pat_no, learn_mask;
  2504.     float           para_bias, para_center, para_weight, para_pain, 
  2505.                     para_momentum,para_delta_max;
  2506.  
  2507.     register struct Unit *unit_ptr;
  2508.     register struct Link *link_ptr;
  2509.  
  2510. #ifdef RBF_LEARN_PROT
  2511.     static int      schritt = 1;
  2512.     int             fehler_zaehler = 0;
  2513.     float           temp_fehler;
  2514.     FILE           *protfile;
  2515.  
  2516. #endif
  2517.  
  2518.     if (NoOfUnits == 0)
  2519.     return (KRERR_NO_UNITS);/* No Units defined         */
  2520.     if (NoOfInParams < 1)    /* has to be changed (must be 4) */
  2521.     return (KRERR_PARAMETERS);    /* Not enough input parameters  */
  2522.  
  2523.     *NoOfOutParams = 1;        /* One return value is available */
  2524.                                 /* (the learning error)         */
  2525.     *parameterOutArray = OutParameter;    /* set the reference to */
  2526.                                         /* the output parameter */
  2527.  
  2528.     ret_code = KRERR_NO_ERROR;    /* default return code         */
  2529.  
  2530.     if (NetModified || (TopoSortID != TOPOLOGICAL_FF)) {
  2531.     ret_code = RbfTopoCheck();
  2532.  
  2533.     if ((ret_code != KRERR_NO_ERROR) && (ret_code != KRERR_DEAD_UNITS))
  2534.         return (ret_code);
  2535.  
  2536.     NetModified = FALSE;
  2537.     }
  2538.     if (NetInitialize || LearnFuncHasChanged) {
  2539.     fprintf(stderr, "Initialization RBF_Weights should be called!\n");
  2540.     /* initialize fields for momentum term */
  2541.     FOR_ALL_UNITS(unit_ptr) {
  2542.         FOR_ALL_LINKS(unit_ptr, link_ptr) {
  2543.         link_ptr->value_a = 0.0;
  2544.         }
  2545.     }
  2546.     }
  2547.     NET_ERROR(OutParameter) = 0.0;
  2548.     para_center = -LEARN_PARAM1(parameterInArray);
  2549.     para_bias = LEARN_PARAM2(parameterInArray);
  2550.     para_weight = LEARN_PARAM3(parameterInArray);
  2551.     para_momentum = LEARN_PARAM5(parameterInArray);
  2552.     para_delta_max = LEARN_PARAM4(parameterInArray);
  2553.     para_pain = 0.0;        /* not used now    */
  2554.  
  2555.     /* set learn mask in condition of the learning parameters:     */
  2556.     learn_mask = 0;
  2557.     if (para_center != 0.0)
  2558.     learn_mask |= RBF_LEARN_CENTER;
  2559.     if (para_bias != 0.0)
  2560.     learn_mask |= RBF_LEARN_BIAS;
  2561.     if (para_weight != 0.0)
  2562.     learn_mask |= RBF_LEARN_WEIGHT;
  2563.     if (para_pain != 0.0)
  2564.     learn_mask |= RBF_LEARN_PAIN;
  2565.  
  2566. #ifndef RBF_INCR_LEARNING
  2567.     ret_code = RbfLearnClean();
  2568.     if (ret_code != KRERR_NO_ERROR)
  2569.     return ret_code;
  2570. #endif
  2571.  
  2572.  
  2573.     /* compute the necessary sub patterns */
  2574.  
  2575.     KernelErrorCode = kr_initSubPatternOrder(start_pattern,end_pattern);
  2576.     if(KernelErrorCode != KRERR_NO_ERROR)
  2577.     return (KernelErrorCode);
  2578.  
  2579.     while(kr_getSubPatternByOrder(&pattern_no,&sub_pat_no)){
  2580.  
  2581.     RbfLearnForward(pattern_no,sub_pat_no);    /* forward propagation     */
  2582.  
  2583.     /* backward propagation                      */
  2584.  
  2585. #ifdef RBF_LEARN_PROT
  2586.     temp_fehler = RbfLearnAdjustDelta(para_center,
  2587.                para_bias, para_weight, para_pain, para_momentum,
  2588.                       para_delta_max, learn_mask);
  2589.     NET_ERROR(OutParameter) += temp_fehler;
  2590.     if (temp_fehler > 0.0)
  2591.         fehler_zaehler++;
  2592. #else
  2593.     NET_ERROR(OutParameter) += RbfLearnAdjustDelta(para_center,
  2594.                para_bias, para_weight, para_pain, para_momentum,
  2595.                         para_delta_max, learn_mask);
  2596. #endif
  2597.     }
  2598.  
  2599. #ifndef RBF_INCR_LEARNING
  2600.     RbfLearnAdjustWeights(para_center, para_bias, para_weight,
  2601.               para_momentum);
  2602. #endif
  2603.  
  2604. #ifdef RBF_LEARN_PROT
  2605.     protfile = fopen("rbf_learn_prot_file", "a");
  2606.     if (schritt == 1) {
  2607.     fprintf(protfile, "# Neues Lernprotokoll: \n");
  2608.     }
  2609.     fprintf(protfile, "%d %f %d\n", schritt, NET_ERROR(OutParameter),
  2610.         fehler_zaehler);
  2611.     fclose(protfile);
  2612.     schritt++;
  2613. #endif
  2614.  
  2615.     return (ret_code);
  2616. }
  2617.  
  2618.  
  2619. /*****************************************************************************
  2620.  *****************************************************************************
  2621.  
  2622.   GROUP        : RPROP learning function
  2623.  
  2624.   AUTHOR       : Martin Riedmiller, ILKD, University of Karlsruhe
  2625.   Notes        : RPROP parameters are the initial update value (default 0.1) 
  2626.                  and the maximal update value (default 50.0). The defaults 
  2627.          are assumed if the parameters are set to 0.0. It may be 
  2628.          helpfull to limit the second paream to 0.01.
  2629.  
  2630.   DATE         : 01.04.1992
  2631.   LAST CHANGE  : 06.11.1993
  2632.  
  2633.              Copyright (c) 1990-1994  SNNS Group, IPVR, Univ. Stuttgart, FRG
  2634.              
  2635. ******************************************************************************
  2636. ******************************************************************************/
  2637.  
  2638. #define RPROP_ETAPLUS 1.2
  2639. #define RPROP_ETAMINUS 0.5
  2640. #define RPROP_MINEPS 1e-6
  2641. #define RPROP_MAXEPS 50.0
  2642. #define RPROP_DEFAULT_UPDATE_VALUE 0.1
  2643.  
  2644.  
  2645. /*****************************************************************************
  2646.   FUNCTION : initializeRprop
  2647.  
  2648.   PURPOSE  : Rprop initialisation:
  2649.   RETURNS  : kernel error code
  2650.   NOTES    : ->value_c : Sum (dEdw)
  2651.              ->value_b : dw(t-1)
  2652.              ->value_a : update_value
  2653.  
  2654.   UPDATE   : 06.11.1993 by Guenter Mamier
  2655. ******************************************************************************/
  2656. static krui_err initializeRprop(float update_val)
  2657.  /* initial update_value */
  2658. {
  2659.     register unsigned short flags;
  2660.     register struct Link *link_ptr;
  2661.     register struct Unit *unit_ptr;
  2662.     register struct Site *site_ptr;
  2663.  
  2664.  
  2665.     FOR_ALL_UNITS(unit_ptr) {
  2666.     flags = unit_ptr->flags;
  2667.  
  2668.     if ((flags & UFLAG_IN_USE) == UFLAG_IN_USE) {    /* unit is in use  */
  2669.         unit_ptr->value_b = unit_ptr->value_c = (FlintType) 0;
  2670.         unit_ptr->value_a = (FlintType) update_val;
  2671.  
  2672.         if (flags & UFLAG_SITES) {    /* unit has sites  */
  2673.         FOR_ALL_SITES_AND_LINKS(unit_ptr, site_ptr, link_ptr) {
  2674.             link_ptr->value_b = link_ptr->value_c = (FlintType) 0;
  2675.             link_ptr->value_a = (FlintType) update_val;
  2676.         }
  2677.  
  2678.         } else {        /* unit has no sites   */
  2679.         if (flags & UFLAG_DLINKS) {    /* unit has direct links   */
  2680.             FOR_ALL_LINKS(unit_ptr, link_ptr) {
  2681.             link_ptr->value_b = link_ptr->value_c = (FlintType) 0;
  2682.             link_ptr->value_a = (FlintType) update_val;
  2683.             }
  2684.         }
  2685.         }
  2686.     }
  2687.     }
  2688.  
  2689.     return (KRERR_NO_ERROR);
  2690. }
  2691.  
  2692.  
  2693.  
  2694. /*****************************************************************************
  2695.   FUNCTION : propagateNetBackwardRprop
  2696.  
  2697.   PURPOSE  : Pure Backpropagation of gradient without weight-update
  2698.   RETURNS  : network error
  2699.   NOTES    : sum(dE/dw) -> value_c.
  2700.  
  2701.   UPDATE   : 06.11.1993 by Guenter Mamier
  2702. ******************************************************************************/
  2703. static float propagateNetBackwardRprop(int pattern_no, int sub_pat_no)
  2704.  /* number of actual pattern  */
  2705. {
  2706.     register struct Link *link_ptr;
  2707.     register struct Site *site_ptr;
  2708.     register struct Unit *unit_ptr;
  2709.     register Patterns out_pat;
  2710.     register float  error,    /* error  */
  2711.                     sum_error,    /* sum of the error  */
  2712.                     devit;    /* deviation  */
  2713.     TopoPtrArray    topo_ptr;
  2714.     int size;
  2715.  
  2716.     sum_error = 0.0;        /* reset network error  */
  2717.  
  2718.     /* calculate address of the output pattern (with number pattern_no + 1)  */
  2719.     out_pat = kr_getSubPatData(pattern_no,sub_pat_no,OUTPUT,&size);
  2720.     out_pat += size;
  2721.  
  2722.     /* add 3 to no_of_topo_units because the topologic array contains 4 NULL
  2723.        pointers  */
  2724.     topo_ptr = topo_ptr_array + (no_of_topo_units + 3);
  2725.  
  2726.     /* calculate output units only  */
  2727.     while ((unit_ptr = *--topo_ptr) != NULL) {
  2728.     devit = *(--out_pat) - unit_ptr->Out.output;
  2729.     /* = o * (1.0 - o) in [0.0,0.25], */
  2730.     /* for asymmetric logistic function */
  2731.  
  2732.     sum_error += devit * devit;    /* sum up the error of the network  */
  2733.  
  2734.     /* calc. error for output units     */
  2735.     error = devit * ((unit_ptr->act_deriv_func) (unit_ptr));
  2736.  
  2737.     unit_ptr->value_c += -error /* * 1 */ ;    /* calculate the bias slopes  */
  2738.     /* learn bias like a weight  */
  2739.     if (UNIT_HAS_DIRECT_INPUTS(unit_ptr)) {    /* the unit has direct links  */
  2740.         FOR_ALL_LINKS(unit_ptr, link_ptr) {    /* calculate the slopes  */
  2741.         link_ptr->value_c += -error * link_ptr->to->Out.output;
  2742.         link_ptr->to->Aux.flint_no += link_ptr->weight * error;
  2743.         }
  2744.     } else {        /* the unit has sites  */
  2745.         FOR_ALL_SITES_AND_LINKS(unit_ptr, site_ptr, link_ptr) {    
  2746.         /* calculate the value_cs  */
  2747.         link_ptr->value_c += -error * link_ptr->to->Out.output;
  2748.         link_ptr->to->Aux.flint_no += link_ptr->weight * error;
  2749.         }
  2750.     }
  2751.     }
  2752.  
  2753.  
  2754.     /* calculate hidden units only  */
  2755.     while ((unit_ptr = *--topo_ptr) != NULL) {
  2756.     error = ((unit_ptr->act_deriv_func) (unit_ptr)) * 
  2757.              unit_ptr->Aux.flint_no;
  2758.  
  2759.     unit_ptr->value_c += -error /* * 1 */ ;    /* calculate the bias slopes  */
  2760.     /* learn bias like a weight  */
  2761.     if (UNIT_HAS_DIRECT_INPUTS(unit_ptr)) {    /* the unit has direct links  */
  2762.         FOR_ALL_LINKS(unit_ptr, link_ptr) {    /* calculate the slopes  */
  2763.         if (link_ptr->to->flags & UFLAG_TTYP_HIDD)
  2764.             /* this link points to a hidden unit: sum up the error's
  2765.                from previos units  */
  2766.             link_ptr->to->Aux.flint_no += link_ptr->weight * error;
  2767.  
  2768.         link_ptr->value_c += -error * link_ptr->to->Out.output;
  2769.         }
  2770.     } else {        /* the unit has sites  */
  2771.         FOR_ALL_SITES_AND_LINKS(unit_ptr, site_ptr, link_ptr) {    
  2772.         /* calculate the slopes  */
  2773.         if (link_ptr->to->flags & UFLAG_TTYP_HIDD)
  2774.             /* this link points to a hidden unit: sum up the error's
  2775.                from previos units  */
  2776.             link_ptr->to->Aux.flint_no += link_ptr->weight * error;
  2777.  
  2778.         link_ptr->value_c += -error * link_ptr->to->Out.output;
  2779.         }
  2780.     }
  2781.     }
  2782.  
  2783. /*    sum_error *= 0.5; */
  2784.     return (sum_error);        /* return the error of the network  */
  2785. }
  2786.  
  2787.  
  2788. /*****************************************************************************
  2789.   FUNCTION : MODI_rprop
  2790.  
  2791.   PURPOSE  : modifies network after each epoch
  2792.   RETURNS  : 
  2793.   NOTES    :
  2794.  
  2795.   UPDATE   : 06.11.1993 by Guenter Mamier
  2796. ******************************************************************************/
  2797. static void MODI_rprop(float maxeps)
  2798. {
  2799.     register struct Link *link_ptr;
  2800.     register struct Site *site_ptr;
  2801.     register struct Unit *unit_ptr;
  2802.     TopoPtrArray    topo_ptr;
  2803.     bool            hidden_units;
  2804.     float           direction;
  2805.  
  2806.  
  2807.     topo_ptr = topo_ptr_array + (NoOfInputUnits + 1);
  2808.     hidden_units = TRUE;
  2809.  
  2810.     /* calculate hidden and output units only  */
  2811.     do {
  2812.     if ((unit_ptr = *++topo_ptr) == NULL) {
  2813.         if (!hidden_units)
  2814.         break;        /* end of topologic pointer array reached  */
  2815.         unit_ptr = *++topo_ptr;    /* skip NULL pointer  */
  2816.         hidden_units = FALSE;
  2817.     }
  2818.     if (IS_SPECIAL_UNIT(unit_ptr)) {    /* Do not change weights */
  2819.         unit_ptr->value_c = 0.0;    /* reset */
  2820.         if (UNIT_HAS_DIRECT_INPUTS(unit_ptr)) {/*the unit has direct links*/
  2821.         FOR_ALL_LINKS(unit_ptr, link_ptr) {
  2822.             link_ptr->value_c = 0.0;    /* reset */
  2823.         }
  2824.         } else {        /* the unit has sites  */
  2825.         FOR_ALL_SITES_AND_LINKS(unit_ptr, site_ptr, link_ptr) {
  2826.             link_ptr->value_c = 0.0;    /* reset */
  2827.         }
  2828.         }
  2829.         continue;        /* next unit */
  2830.     }
  2831.     direction = unit_ptr->value_b * unit_ptr->value_c;
  2832.     if (direction < 0.0) {    /* same direction : dw * dEdw < 0  */
  2833.         unit_ptr->value_a *= RPROP_ETAPLUS;    /* adapt update_value */
  2834.         if (unit_ptr->value_a > maxeps)
  2835.         unit_ptr->value_a = maxeps;
  2836.         if (unit_ptr->value_c < 0.0)
  2837.         unit_ptr->value_b = unit_ptr->value_a;
  2838.         else
  2839.         unit_ptr->value_b = -(unit_ptr->value_a);
  2840.     } else if (direction > 0.0) {    /* direction changed  */
  2841.         unit_ptr->bias -= unit_ptr->value_b;      /* revert previous step */
  2842.         unit_ptr->value_b = 0;    /* reset for restarting adaptation in
  2843.                        next step */
  2844.         unit_ptr->value_a *= RPROP_ETAMINUS;    /* adapt update_value */
  2845.         if (unit_ptr->value_a < RPROP_MINEPS)
  2846.         unit_ptr->value_a = RPROP_MINEPS;
  2847.     } else {
  2848.         /* start of RPROP learning process */
  2849.         if (unit_ptr->value_c < 0.0)
  2850.         unit_ptr->value_b = unit_ptr->value_a;
  2851.         else if (unit_ptr->value_c > 0.0)
  2852.         unit_ptr->value_b = -(unit_ptr->value_a);
  2853.  
  2854.         /* else no action if  derivative was zero */
  2855.  
  2856.     }
  2857.  
  2858.     unit_ptr->bias += unit_ptr->value_b;    /* compute new bias */
  2859.     unit_ptr->value_c = 0.0;/* reset */
  2860.  
  2861.     /* adjust links */
  2862.     if (UNIT_HAS_DIRECT_INPUTS(unit_ptr)) {    /* the unit has direct links  */
  2863.         FOR_ALL_LINKS(unit_ptr, link_ptr) {
  2864.         direction = link_ptr->value_b * link_ptr->value_c;
  2865.         if (direction < 0.0) {    /* same direction : dw * dEdw < 0  */
  2866.             link_ptr->value_a *= RPROP_ETAPLUS;    /* adapt update_value */
  2867.             if (link_ptr->value_a > maxeps)
  2868.             link_ptr->value_a = maxeps;
  2869.             if (link_ptr->value_c < 0.0)
  2870.             link_ptr->value_b = link_ptr->value_a;
  2871.             else
  2872.             link_ptr->value_b = -(link_ptr->value_a);
  2873.         } else if (direction > 0.0) {    /* direction changed  */
  2874.             link_ptr->weight -= link_ptr->value_b; /* revert previous 
  2875.                                   step */
  2876.             link_ptr->value_b = 0;    /* reset for restarting
  2877.                            adaptation in next step */
  2878.             link_ptr->value_a *= RPROP_ETAMINUS;/* adapt update_value */
  2879.             if (link_ptr->value_a < RPROP_MINEPS)
  2880.             link_ptr->value_a = RPROP_MINEPS;
  2881.         } else {
  2882.             /* start of RPROP learning process  */
  2883.             if (link_ptr->value_c < 0.0)
  2884.             link_ptr->value_b = link_ptr->value_a;
  2885.             else if (link_ptr->value_c > 0.0)
  2886.             link_ptr->value_b = -(link_ptr->value_a);
  2887.  
  2888.             /* else no action if  derivative was zero */
  2889.  
  2890.         }
  2891.  
  2892.         link_ptr->weight += link_ptr->value_b;    /* compute new bias */
  2893.         link_ptr->value_c = 0.0;            /* reset */
  2894.  
  2895.  
  2896.         }
  2897.     } else {        /* the unit has sites  */
  2898.         FOR_ALL_SITES_AND_LINKS(unit_ptr, site_ptr, link_ptr) {
  2899.         if (direction < 0.0) {    /* same direction : dw * dEdw <! 0  */
  2900.             link_ptr->value_a *= RPROP_ETAPLUS;    /* adapt update_value */
  2901.             if (link_ptr->value_a > maxeps)
  2902.             link_ptr->value_a = maxeps;
  2903.             if (link_ptr->value_c < 0.0)
  2904.             link_ptr->value_b = link_ptr->value_a;
  2905.             else
  2906.             link_ptr->value_b = -(link_ptr->value_a);
  2907.         } else if (direction > 0.0) {    /* direction changed  */
  2908.             link_ptr->weight -= link_ptr->value_b; /* revert previous 
  2909.                                   step */
  2910.             link_ptr->value_b = 0;    /* reset for restarting
  2911.                            adaptation in next step */
  2912.             link_ptr->value_a *= RPROP_ETAMINUS;/* adapt update_value */
  2913.             if (link_ptr->value_a < RPROP_MINEPS)
  2914.             link_ptr->value_a = RPROP_MINEPS;
  2915.         } else {
  2916.             /* start of RPROP learning process */
  2917.             if (link_ptr->value_c < 0.0)
  2918.             link_ptr->value_b = link_ptr->value_a;
  2919.             else if (link_ptr->value_c > 0.0)
  2920.             link_ptr->value_b = -(link_ptr->value_a);
  2921.  
  2922.             /* else no action if  derivative was zero */
  2923.  
  2924.         }
  2925.  
  2926.         link_ptr->weight += link_ptr->value_b;    /* compute new bias */
  2927.         link_ptr->value_c = 0.0;    /* reset */
  2928.  
  2929.  
  2930.         }
  2931.     }
  2932.     }                /* for units  */
  2933.     while (TRUE);
  2934.  
  2935. }
  2936.  
  2937.  
  2938. /*****************************************************************************
  2939.   FUNCTION : LEARN_rprop
  2940.  
  2941.   PURPOSE  : RPROP learning function
  2942.   RETURNS  : kernel error code
  2943.   NOTES    : Input Parameters:   1 : initial update value
  2944.                                  2 : maxeps;
  2945.                      3 : blocksize;   (learning by block)
  2946.  
  2947.              Output Parameters:  1 : error of the network (sum of all cycles)
  2948.  
  2949.   UPDATE   : 06.11.1993 by Guenter Mamier
  2950. ******************************************************************************/
  2951. krui_err LEARN_rprop(int start_pattern, int end_pattern, 
  2952.              float *parameterInArray, int NoOfInParams, 
  2953.              float **parameterOutArray, int *NoOfOutParams)
  2954. {
  2955.     static float    OutParameter[1];    /* OutParameter[0] stores the */
  2956.  
  2957.     /* learning error */
  2958.     int             i, pattern_no, sub_pat_no, ret_code, blocksize;
  2959.     float           maxeps, update_value;
  2960.  
  2961.  
  2962.  
  2963.     if (NoOfUnits == 0)
  2964.     return (KRERR_NO_UNITS);/* No Units defined  */
  2965.  
  2966.     if (NoOfInParams < 3)
  2967.     return (KRERR_PARAMETERS);    /* not enough input parameters  */
  2968.  
  2969.     /* DEFAULTS: */
  2970.  
  2971.     if ((update_value = LEARN_PARAM1(parameterInArray)) == 0.0)
  2972.     update_value = RPROP_DEFAULT_UPDATE_VALUE;
  2973.     if ((maxeps = LEARN_PARAM2(parameterInArray)) == 0.0)
  2974.     maxeps = RPROP_MAXEPS;
  2975.     if (update_value > maxeps)
  2976.     update_value = maxeps;
  2977.  
  2978.  
  2979.     *NoOfOutParams = 1;        /* one return value */
  2980.  
  2981.     *parameterOutArray = OutParameter;    /* set output parameter reference  */
  2982.     ret_code = KRERR_NO_ERROR;    /* reset return code  */
  2983.  
  2984.     if (NetModified || (TopoSortID != TOPOLOGICAL_FF)) {       
  2985.     /* Net has been modified  or topologic array isn't initialized */
  2986.     /* check the topology of the network  */
  2987.     ret_code = kr_topoCheck();
  2988.     if (ret_code < KRERR_NO_ERROR)
  2989.         return (ret_code);    /* an error has occured  */
  2990.     if (ret_code < 2)
  2991.         return (KRERR_NET_DEPTH);    /* the network has less then 2 layers */
  2992.  
  2993.     /* count the no. of I/O units and check the patterns  */
  2994.     ret_code = kr_IOCheck();
  2995.     if (ret_code < KRERR_NO_ERROR)
  2996.         return (ret_code);
  2997.  
  2998.     /* sort units by topology and by topologic type  */
  2999.     ret_code = kr_topoSort(TOPOLOGICAL_FF);
  3000.     if ((ret_code != KRERR_NO_ERROR) && (ret_code != KRERR_DEAD_UNITS))
  3001.         return (ret_code);
  3002.  
  3003.     NetModified = FALSE;
  3004.     }
  3005.     if (NetInitialize || LearnFuncHasChanged) {    /* Net has been modified or
  3006.                            initialized, initialize
  3007.                            RPROP */
  3008.     ret_code = initializeRprop(update_value);
  3009.     if (ret_code != KRERR_NO_ERROR)
  3010.         return (ret_code);
  3011.     }
  3012.     /* DEFAULTS: */
  3013.     if ((blocksize = LEARN_PARAM3(parameterInArray)) == 0)
  3014.     blocksize = end_pattern;
  3015.  
  3016.  
  3017.     /* compute the necessary sub patterns */
  3018.  
  3019.     KernelErrorCode = kr_initSubPatternOrder(start_pattern,blocksize);
  3020.     if(KernelErrorCode != KRERR_NO_ERROR)
  3021.     return (KernelErrorCode);
  3022.  
  3023.  
  3024.     NET_ERROR(OutParameter) = 0.0;    /* reset network error value  */
  3025.  
  3026.     while(kr_getSubPatternByOrder(&pattern_no,&sub_pat_no)){
  3027.  
  3028.     propagateNetForward(pattern_no,sub_pat_no);   /* forward propagation  */
  3029.  
  3030.     /* backward propagation and summation of gradient  */
  3031.     NET_ERROR(OutParameter) 
  3032.         += propagateNetBackwardRprop(pattern_no,sub_pat_no);
  3033.     }
  3034.  
  3035.     /* modificate links and bias  */
  3036.     MODI_rprop(maxeps);
  3037.     return (ret_code);
  3038. }
  3039.  
  3040.  
  3041.  
  3042. /*****************************************************************************
  3043.  *****************************************************************************
  3044.  
  3045.   GROUP        : ART 1 learning function
  3046.  
  3047.   AUTHOR       : Kai-Uwe Herrmann
  3048.  
  3049.   DATE         : 01.08.1992
  3050.   LAST CHANGE  : 06.11.1993
  3051.  
  3052.              Copyright (c) 1990-1994  SNNS Group, IPVR, Univ. Stuttgart, FRG
  3053.              
  3054. ******************************************************************************
  3055. ******************************************************************************/
  3056.  
  3057.  
  3058.  
  3059. /*****************************************************************************
  3060.   FUNCTION : LEARN_ART1
  3061.  
  3062.   PURPOSE  : ART 1 learning function.
  3063.   RETURNS  : kernel error code
  3064.   NOTES    : 1 input-parameter  :  1. vigilance parameter RHO
  3065.  
  3066.              output-parameters  :  numbers of classified patterns,
  3067.                                    separator -1,
  3068.                                    numbers of not classifiable patterns
  3069.  
  3070.   UPDATE   : 06.11.1993 by Guenter Mamier
  3071. ******************************************************************************/
  3072. krui_err  LEARN_ART1(int start_pattern, int end_pattern,
  3073.              float parameterInArray[], int NoOfInParams,
  3074.              float **parameterOutArray, int *NoOfOutParams)
  3075. {
  3076.     krui_err        ret_code = KRERR_NO_ERROR;
  3077.     int             pattern_no, sub_pat_no;    /* Contains actual */
  3078.                         /* pattern number */
  3079.     int             start, end;
  3080.     int             i,n;
  3081.     struct Unit    *winner_ptr;    /* recognition unit which is the winner of
  3082.                    w.t.a  */
  3083.     TopoPtrArray    topo_layer[6];    /* topo_layer[0] : *first input unit
  3084.                        topo_layer[1] : *first comp. unit
  3085.                        topo_layer[2] : *first rec.  unit
  3086.                        topo_layer[3] : *first delay unit
  3087.                        topo_layer[4] : *first local reset
  3088.                        unit topo_layer[5] : *first
  3089.                        special unit (classified_unit) */
  3090.     TopoPtrArray    topo_ptr;
  3091.     FlintType       beta;
  3092.     float           rho;
  3093.  
  3094.  
  3095.     /* Check number of incoming parameters */
  3096.  
  3097.     if (NoOfInParams < 1) {
  3098.     ret_code = KRERR_PARAMETERS;
  3099.     return (ret_code);
  3100.     }                /* if */
  3101.     /* rho is the vigilance parameter   */
  3102.     rho = parameterInArray[0];
  3103.  
  3104.  
  3105.     /* Check interval for vigilance parameter and constant value L */
  3106.  
  3107.     if ((rho < 0.0) || (rho > 1.0)) {
  3108.     ret_code = KRERR_PARAMETERS;
  3109.     return (ret_code);
  3110.     }                /* if */
  3111.     /* Check if network has been modified or learning func has been changed */
  3112.     if (NetModified || LearnFuncHasChanged || (TopoSortID != ART1_TOPO_TYPE)) {
  3113.     (void) kr_topoSort(ART1_TOPO_TYPE);
  3114.     ret_code = KernelErrorCode;
  3115.     if (ret_code != KRERR_NO_ERROR) {
  3116.         NetModified = TRUE;
  3117.         return (ret_code);
  3118.     }            /* if */
  3119.     NetModified = FALSE;
  3120.     LearnFuncHasChanged = FALSE;
  3121.     }                /* if */
  3122.     /* set initial activation values */
  3123.     ret_code = kra1_init_i_act(rho);
  3124.  
  3125.     if (ret_code != KRERR_NO_ERROR) {
  3126.     return (ret_code);
  3127.     }                /* if */
  3128.     /* beta is another learning parameter of the network which is determined
  3129.        when initializing the network. It is there written to the bias field
  3130.        of the structure of each unit. Now we will read this value. */
  3131.     beta = (unit_array + 1)->bias;
  3132.  
  3133.     if (beta <= 0.0) {
  3134.     topo_msg.error_code = KRERR_PARAM_BETA;
  3135.     topo_msg.src_error_unit = 0;
  3136.     topo_msg.dest_error_unit = 1;
  3137.     return (topo_msg.error_code);
  3138.     }                /* if */
  3139.     /* # of output parameters is 0  */
  3140.     *NoOfOutParams = 0;
  3141.     *parameterOutArray = NULL;
  3142.  
  3143.  
  3144.     /* get pointers to first elements of each layer in topo_ptr_array */
  3145.  
  3146.     topo_ptr = topo_ptr_array + 1;
  3147.  
  3148.     for (i = 0; i <= 5; i++) {
  3149.     topo_layer[i] = topo_ptr;
  3150.     do {
  3151.     } while (*topo_ptr++ != NULL);
  3152.  
  3153.     }                /* for */
  3154.  
  3155.  
  3156.     /* compute the necessary sub patterns */
  3157.  
  3158.     KernelErrorCode = kr_initSubPatternOrder(start_pattern,end_pattern);
  3159.     if(KernelErrorCode != KRERR_NO_ERROR)
  3160.     return (KernelErrorCode);
  3161.  
  3162.  
  3163.     /* Search phase */
  3164.     start = kr_AbsPosOfFirstSubPat(start_pattern);
  3165.     end   = kr_AbsPosOfFirstSubPat(end_pattern);
  3166.     end  += kr_NoOfSubPatPairs(end_pattern) - 1;
  3167.  
  3168.     for(n=start; n<=end; n++){
  3169.  
  3170.     kr_getSubPatternByNo(&pattern_no,&sub_pat_no,n);
  3171.     
  3172.     /* initialize the unit activations of the whole net */
  3173.  
  3174.     ret_code = krart_reset_activations();
  3175.     if (ret_code != KRERR_NO_ERROR) {
  3176.         return (ret_code);
  3177.     }            /* if */
  3178.     /* put pattern into input units */
  3179.     ret_code = put_ART1_in_pattern(pattern_no, sub_pat_no, topo_layer[0]);
  3180.     if (ret_code != KRERR_NO_ERROR) {
  3181.         return (ret_code);
  3182.     }            /* if */
  3183.     /* repeat synchronous propagation and look for winner until pattern
  3184.        is classified or network tells us, that pattern is not
  3185.        classifiable */
  3186.     do {
  3187.         /* 1 propagation step (all units push their information onto
  3188.            their output and calculate their new activation. */
  3189.  
  3190.         krart_prop_synch();
  3191.  
  3192.         /* look for the recognition unit with the highest activation
  3193.            returns a NULL pointer if all recognition units have
  3194.            activation 0.0 */
  3195.         winner_ptr = krart_get_winner(topo_layer[2], 1.0);
  3196.  
  3197.     } while (!(ART1_CLASSIFIED) && !(ART1_NOT_CLASSIFIABLE));
  3198.  
  3199.  
  3200.     /* training phase */
  3201.  
  3202.     if (ART1_CLASSIFIED) {
  3203.  
  3204.         /* Train network i.e. adjust weights between comparison layer and
  3205.            winner_unit and vice versa */
  3206.  
  3207.         ret_code = adjust_ART1_weights(beta, topo_layer[1],
  3208.                        topo_layer[3], winner_ptr);
  3209.  
  3210.         if (ret_code != KRERR_NO_ERROR) {
  3211.         return (ret_code);
  3212.         }/* if */
  3213.     }/* if */
  3214.     }/* for */
  3215.  
  3216.  
  3217.     return (ret_code);
  3218.  
  3219. }/* LEARN_ART1 */
  3220.  
  3221.  
  3222.  
  3223.  
  3224. /*****************************************************************************
  3225.   FUNCTION : put_ART1_in_pattern
  3226.  
  3227.   PURPOSE  : pushes a new pattern into the input units of the network
  3228.   RETURNS  : kernel error code
  3229.   NOTES    :
  3230.  
  3231.   UPDATE   : 06.11.1993 by Guenter Mamier
  3232. ******************************************************************************/
  3233. static krui_err put_ART1_in_pattern(int pattern_no, int sub_pat_no, 
  3234.                     TopoPtrArray topo_inp_ptr)
  3235. {
  3236.     int             ret_code = KRERR_NO_ERROR;
  3237.     register Patterns in_pat;
  3238.     struct Unit    *unit_ptr;
  3239.     TopoPtrArray    topo_ptr = topo_inp_ptr;
  3240.  
  3241.     /* calculate startadress of actual pattern   */
  3242.     in_pat = kr_getSubPatData(pattern_no,sub_pat_no,INPUT,NULL);
  3243.  
  3244.     while ((unit_ptr = *topo_ptr++) != NULL) {
  3245.     if (unit_ptr->out_func == OUT_IDENTITY) {
  3246.         unit_ptr->act = unit_ptr->Out.output = *in_pat++;
  3247.     } else {
  3248.         unit_ptr->act = *in_pat++;
  3249.         unit_ptr->Out.output = (*unit_ptr->out_func) (unit_ptr->act);
  3250.     }/* if */
  3251.     }/* while */
  3252.  
  3253.     return (ret_code);
  3254.  
  3255. }/* put_ART1_in_pattern */
  3256.  
  3257.  
  3258.  
  3259. /*****************************************************************************
  3260.   FUNCTION : adjust_ART1_weights
  3261.  
  3262.   PURPOSE  : training function for ART1 networks
  3263.   RETURNS  : kernel error code
  3264.   NOTES    : Parameters:  
  3265.              beta         constant value beta > 0.0
  3266.  
  3267.              comp_ptr     points to pointer to first comparison unit
  3268.  
  3269.              delay_ptr    points to pointer to first unit in the delay layer. 
  3270.                       The t(j,i) links are not between recognition layer 
  3271.               and comparison layer but between the respective 
  3272.               delay unit of the recogniton unit and the comparison 
  3273.               layer. So first we have to look for the corresponding
  3274.               delay unit of the winning unit before training these 
  3275.               weights.
  3276.  
  3277.              winner_ptr   points to winning unit of the recognition layer.
  3278.  
  3279.   UPDATE   : 06.11.1993 by Guenter Mamier
  3280. ******************************************************************************/
  3281. static krui_err adjust_ART1_weights(double beta, TopoPtrArray comp_ptr,
  3282.                     TopoPtrArray delay_ptr,
  3283.                     struct Unit * winner_ptr)
  3284. {
  3285.     krui_err        ret_code = KRERR_NO_ERROR;
  3286.     TopoPtrArray    topo_ptr = NULL;
  3287.     struct Unit    *unit_ptr_comp = NULL, *unit_ptr_delay = NULL;
  3288.     struct Link    *link_ptr = NULL;
  3289.     bool            found_delay_unit = FALSE;
  3290.     FlintType       sum_ck = 0.0;
  3291.  
  3292.  
  3293.     /* get corresponding unit of the winning unit in the delay layer */
  3294.  
  3295.     topo_ptr = delay_ptr;
  3296.  
  3297.     while ((!found_delay_unit) && (*topo_ptr != NULL)) {
  3298.  
  3299.     unit_ptr_delay = *topo_ptr++;
  3300.  
  3301.     if (((struct Link *) unit_ptr_delay->sites)->to == winner_ptr) {
  3302.         found_delay_unit = TRUE;
  3303.     }/* if */
  3304.     }/* while */
  3305.  
  3306.     if (!found_delay_unit) {
  3307.  
  3308.     /* There was no delay unit found corresponding to the winning
  3309.        recognition unit */
  3310.  
  3311.     ret_code = KRERR_TOPOLOGY;
  3312.     return (ret_code);
  3313.  
  3314.     }/* if */
  3315.     /* Adjust weights between winning unit (delay-layer) and comparison layer
  3316.        (t(j,i) link values)
  3317.     
  3318.     t(j,i) = c(i)   where j is the number of the winning neuron in the delay
  3319.        layer and i ist the number of a comparison unit. */
  3320.     topo_ptr = comp_ptr;
  3321.  
  3322.     while ((unit_ptr_comp = *topo_ptr++) != NULL) {
  3323.  
  3324.     sum_ck += unit_ptr_comp->act;    /* sum up activatons of comparison
  3325.                        layer. sum_ck is needed for b(i,j) */
  3326.  
  3327.     FOR_ALL_LINKS(unit_ptr_comp, link_ptr) {
  3328.  
  3329.         if (link_ptr->to == unit_ptr_delay) {
  3330.         link_ptr->weight = ART1_ADJUST_LINK_DEL_CMP(unit_ptr_comp);
  3331.         }/* if */
  3332.     }/* FOR_ALL_LINKS */
  3333.  
  3334.     }/* while */
  3335.  
  3336.  
  3337.     /* Adjust weights between comparison layer and winning unit (recognition
  3338.        layer) (b(i,j) link values)
  3339.     
  3340.        b(i,j) = c(i) / (beta + sum(k)(c(k)))
  3341.     
  3342.        where j is the number of the winning neuron in the recognition layer, i
  3343.        ist the number of a comparison unit and k runs over all comparison
  3344.        units. (sum(k)(c(k))) = sum_ck. 
  3345.     */
  3346.  
  3347.  
  3348.     FOR_ALL_LINKS(winner_ptr, link_ptr) {
  3349.  
  3350.     if (link_ptr->to->lln == ART1_CMP_LAY) {
  3351.         link_ptr->weight = (FlintType)ART1_ADJUST_LINK_CMP_REC(link_ptr->to,
  3352.                                    beta,sum_ck);
  3353.     }/* if */
  3354.     }/* FOR_ALL_LINKS */
  3355.  
  3356.  
  3357.     return (ret_code);
  3358. }/* adjust_ART1_weights () */
  3359.  
  3360.  
  3361. /*****************************************************************************
  3362.  *****************************************************************************
  3363.  
  3364.   GROUP        : ART2 learning function
  3365.  
  3366.   AUTHOR       : Kai-Uwe Herrmann
  3367.  
  3368.   DATE         : 01.08.1992
  3369.   LAST CHANGE  : 06.11.1993
  3370.  
  3371.              Copyright (c) 1990-1994  SNNS Group, IPVR, Univ. Stuttgart, FRG
  3372.              
  3373. ******************************************************************************
  3374. ******************************************************************************/
  3375.  
  3376.  
  3377. /*****************************************************************************
  3378.   FUNCTION : LEARN_ART2
  3379.  
  3380.   PURPOSE  : ART2 learning function.
  3381.   RETURNS  : kernel error code
  3382.   NOTES    : Parameters: 
  3383.                     6 input-parameter  :  1. vigilance parameter RHO
  3384.                                           2. Parameter a
  3385.                                           3. Parameter b
  3386.                                           4. Parameter c
  3387.                                           5. Parameter e
  3388.                                           6. Parameter THETA
  3389.  
  3390.                     output-parameters  :  none
  3391.  
  3392.  
  3393.   UPDATE   : 06.11.1993 by Guenter Mamier
  3394. ******************************************************************************/
  3395. krui_err LEARN_ART2(int start_pattern, int end_pattern,
  3396.             float parameterInArray[], int NoOfInParams,
  3397.             float **parameterOutArray, int *NoOfOutParams)
  3398. {
  3399.     krui_err        ret_code = KRERR_NO_ERROR;
  3400.     int             pattern_no, sub_pat_no; /* Contains actual pattern number */
  3401.     int             i,n;
  3402.     int             start, end;
  3403.     struct Unit    *winner_ptr;    /* recognition unit which is the winner of
  3404.                    w.t.a */
  3405.     TopoPtrArray    topo_layer[12];    /* topo_layer[0] : *first input unit
  3406.                        topo_layer[1] : *first w unit
  3407.                        topo_layer[2] : *first x unit
  3408.                        topo_layer[3] : *first u unit
  3409.                        topo_layer[4] : *first v unit
  3410.                        topo_layer[5] : *first p unit
  3411.                        topo_layer[6] : *first q unit
  3412.                        topo_layer[7] : *first r unit
  3413.                        topo_layer[8] : *first rec.  unit
  3414.                        topo_layer[10] : *first local
  3415.                        reset unit */
  3416.     TopoPtrArray    topo_ptr;
  3417.     FlintType       rho, param_a, param_b, param_c, param_d, theta;
  3418.  
  3419.  
  3420.     /* Check number of incoming parameters */
  3421.  
  3422.     if (NoOfInParams < 5) {
  3423.     ret_code = KRERR_PARAMETERS;
  3424.     return (ret_code);
  3425.     }/* if */
  3426.     rho = parameterInArray[0];
  3427.     param_a = parameterInArray[1];
  3428.     param_b = parameterInArray[2];
  3429.     param_c = parameterInArray[3];
  3430.     theta = parameterInArray[4];
  3431.  
  3432.  
  3433.     /* Check if network has been modified or learning func has been changed */
  3434.  
  3435.     if (NetModified || LearnFuncHasChanged || (TopoSortID != ART2_TOPO_TYPE)) {
  3436.     (void) kr_topoSort(ART2_TOPO_TYPE);
  3437.     ret_code = KernelErrorCode;
  3438.     if (ret_code != KRERR_NO_ERROR) {
  3439.         NetModified = TRUE;
  3440.         return (ret_code);
  3441.     }/* if */
  3442.     NetModified = FALSE;
  3443.     LearnFuncHasChanged = FALSE;
  3444.     }/* if */
  3445.     /* Read out value of parameter d from bias field of any unit. The value
  3446.        has been written into the bias field by the init-function */
  3447.     param_d = (*(topo_ptr_array + 1))->bias;
  3448.  
  3449.  
  3450.     /* Check values of the parameters */
  3451.  
  3452.     if ((rho < 0.0) || (rho > 1.0) ||
  3453.     (param_a <= 0.0) || (param_b <= 0.0) ||
  3454.     ((param_c * param_d) / (1 - param_d) > 1.0) ||
  3455.     (theta < 0.0) || (theta > 1.0)
  3456.     ) {
  3457.     ret_code = KRERR_PARAMETERS;
  3458.     return (ret_code);
  3459.     }/* if */
  3460.     ret_code = kra2_set_params(rho, param_a, param_b, param_c, param_d, theta);
  3461.  
  3462.     if (ret_code != KRERR_NO_ERROR) {
  3463.     return (ret_code);
  3464.     }/* if */
  3465.     ret_code = kra2_init_propagate();
  3466.  
  3467.     if (ret_code != KRERR_NO_ERROR) {
  3468.     return (ret_code);
  3469.     }/* if */
  3470.     /* get pointers to first elements of each layer in topo_ptr_array */
  3471.     topo_ptr = topo_ptr_array + 1;
  3472.  
  3473.     for (i = 0; i <= 9; i++) {
  3474.     topo_layer[i] = topo_ptr;
  3475.     do {
  3476.     } while (*topo_ptr++ != NULL);
  3477.  
  3478.     }/* for */
  3479.  
  3480.  
  3481.     /* compute the necessary sub patterns */
  3482.  
  3483.     KernelErrorCode = kr_initSubPatternOrder(start_pattern,end_pattern);
  3484.     if(KernelErrorCode != KRERR_NO_ERROR)
  3485.     return (KernelErrorCode);
  3486.  
  3487.  
  3488.     /* Search phase */
  3489.     start = kr_AbsPosOfFirstSubPat(start_pattern);
  3490.     end   = kr_AbsPosOfFirstSubPat(end_pattern);
  3491.     end  += kr_NoOfSubPatPairs(end_pattern) - 1;
  3492.  
  3493.     for(n=start; n<=end; n++){
  3494.  
  3495.     kr_getSubPatternByNo(&pattern_no,&sub_pat_no,n);
  3496.  
  3497.     /* initialize the unit activations of the whole net */
  3498.  
  3499.     ret_code = krart_reset_activations();
  3500.     if (ret_code != KRERR_NO_ERROR) {
  3501.         return (ret_code);
  3502.     }/* if */
  3503.     /* put pattern into input units */
  3504.     ret_code = put_ART2_in_pattern(pattern_no, sub_pat_no,
  3505.                        topo_layer[ART2_INP_LAY-1]);
  3506.     if (ret_code != KRERR_NO_ERROR) {
  3507.         return (ret_code);
  3508.     }/* if */
  3509.  
  3510.     /* initialize of ART2 Simulator for new pattern */
  3511.     kra2_init_pattern();
  3512.  
  3513.     /* repeat synchronous propagation and look for winner until pattern
  3514.        is classified or network tells us, that pattern is not
  3515.        classifiable */
  3516.  
  3517.     do {
  3518.  
  3519.         /* compute vector norms */
  3520.         kra2_compute_norms();
  3521.  
  3522.         /* save old activation values of f1-units */
  3523.         kra2_save_for_stability_check();
  3524.  
  3525.         /* 1 propagation step (all units push their information onto
  3526.            their output and calculate their new activation. */
  3527.         krart_prop_synch();
  3528.  
  3529.         /* look for the recognition unit with the highest activation
  3530.            returns a NULL pointer if all recognition units have
  3531.            activation 0.0 */
  3532.         winner_ptr = krart_get_winner(topo_layer[ART2_REC_LAY-1], param_d);
  3533.  
  3534.         /* Check if F1-Layer is stable */
  3535.         kra2_check_f1_stability();
  3536.  
  3537.         /* Check Reset */
  3538.         kra2_checkReset();
  3539.  
  3540.     } while (!(ART2_CLASSIFIED) && !(ART2_NOT_CLASSIFIABLE));
  3541.  
  3542.  
  3543.     /* training phase */
  3544.  
  3545.     if (ART2_CLASSIFIED) {
  3546.  
  3547.         /* Train network i.e. adjust weights between comparison layer and
  3548.            winner_unit and vice versa */
  3549.         ret_code = adjust_ART2_weights(param_d, topo_layer[ART2_P_LAY - 1],
  3550.                        winner_ptr);
  3551.  
  3552.         if (ret_code != KRERR_NO_ERROR) {
  3553.         return (ret_code);
  3554.         }/* if */
  3555.     }/* if */
  3556.     }/* for */
  3557.  
  3558.     return (ret_code);
  3559.  
  3560. }/* LEARN_ART2 */
  3561.  
  3562.  
  3563.  
  3564. /*****************************************************************************
  3565.   FUNCTION : krui_err put_ART2_in_pattern
  3566.  
  3567.   PURPOSE  : pushes a new pattern into the input units of the network
  3568.   RETURNS  : kernel error code
  3569.   NOTES    :
  3570.  
  3571.   UPDATE   : 06.11.1993 by Guenter Mamier
  3572. ******************************************************************************/
  3573. static krui_err put_ART2_in_pattern(int pattern_no, int sub_pat_no,
  3574.                     TopoPtrArray topo_inp_ptr)
  3575. {
  3576.     int               ret_code = KRERR_NO_ERROR;
  3577.     register Patterns in_pat;
  3578.     struct Unit       *unit_ptr;
  3579.     TopoPtrArray      topo_ptr = topo_inp_ptr;
  3580.  
  3581.     /* calculate startadress of actual pattern */
  3582.     in_pat = kr_getSubPatData(pattern_no,sub_pat_no,INPUT,NULL);
  3583.  
  3584.     while ((unit_ptr = *topo_ptr++) != NULL) {
  3585.  
  3586.     if (unit_ptr->out_func == OUT_IDENTITY) {
  3587.         unit_ptr->act = unit_ptr->Out.output = *in_pat++;
  3588.     } else {
  3589.         unit_ptr->act = *in_pat++;
  3590.         unit_ptr->Out.output = (*unit_ptr->out_func) (unit_ptr->act);
  3591.     }/* if */
  3592.  
  3593.     }/* while */
  3594.  
  3595.     return (ret_code);
  3596.  
  3597. }/* put_ART2_in_pattern */
  3598.  
  3599.  
  3600.  
  3601. /*****************************************************************************
  3602.   FUNCTION : adjust_ART2_weights
  3603.  
  3604.   PURPOSE  : training function for ART2 networks
  3605.   RETURNS  : kernel error code
  3606.   NOTES    : Parameters:  
  3607.              param_d     constant value 0 < param_d < 1
  3608.  
  3609.              p_ptr       points to pointer to first comparison unit
  3610.  
  3611.              delay_ptr   points to pointer to first unit in the delay layer. 
  3612.                      The z(j,i) links are not between recognition layer 
  3613.              and comparison layer but between the respective delay 
  3614.              unit of the recogniton unit and the comparison layer.
  3615.              So first we have to look for the corresponding delay 
  3616.              unit of the winning unit before training these weights.
  3617.  
  3618.              winner_ptr  points to winning unit of the recognition layer.
  3619.  
  3620.   UPDATE   : 06.11.1993 by Guenter Mamier
  3621. ******************************************************************************/
  3622. static krui_err adjust_ART2_weights(double param_d, TopoPtrArray p_ptr,
  3623.                     struct Unit * winner_ptr)
  3624. {
  3625.     krui_err        ret_code = KRERR_NO_ERROR;
  3626.     TopoPtrArray    topo_ptr = NULL;
  3627.     struct Unit    *unit_ptr_p = NULL;
  3628.     struct Link    *link_ptr = NULL, *link_ptr_u = NULL;
  3629.  
  3630.     /* Adjust weights between winning unit and p layer (z(J,i) link values)
  3631.     
  3632.        (d/dt) z(J,i) = z(J,i) + d * (1-d) * [ u(i)/(1-d) - z(J,i) ]
  3633.     
  3634.        for (d/dt) -> 0:        z(J,i) = u(i)/(1-d) 
  3635.     */
  3636.  
  3637.     topo_ptr = p_ptr;
  3638.  
  3639.     while ((unit_ptr_p = *topo_ptr++) != NULL) {
  3640.     FOR_ALL_LINKS(unit_ptr_p, link_ptr) {
  3641.         if (link_ptr->to == winner_ptr) {
  3642.  
  3643.         /* lookin' for corresponding u unit */
  3644.         FOR_ALL_LINKS(unit_ptr_p, link_ptr_u) {
  3645.             if (link_ptr_u->to->lln == ART2_U_LAY) {
  3646.             link_ptr->weight =
  3647.                 ART2_ADJUST_LINK_REC_P(link_ptr_u->to, param_d);
  3648.             break;
  3649.             }/* if */
  3650.         }/* FOR_ALL_LINKS */
  3651.  
  3652.         }/* if */
  3653.     }/* FOR_ALL_LINKS */
  3654.     }/* while */
  3655.  
  3656.  
  3657.     /* Adjust weights between p layer and winning unit (recognition layer)
  3658.        (z(i,j) link values)
  3659.     
  3660.        (d/dt) z(i,J) = d * (1-d) * [ u(i)/(1-d) - z(i,J) ]
  3661.     
  3662.        where J is the number of the winning neuron in the recognition layer, i
  3663.        ist the number of a p unit
  3664.     
  3665.        for (d/dt) -> 0:   z(i,J) = u(i)/(1-d)
  3666.     
  3667.     */
  3668.  
  3669.  
  3670.     FOR_ALL_LINKS(winner_ptr, link_ptr) {
  3671.     if (link_ptr->to->lln == ART2_P_LAY) {
  3672.  
  3673.         /* lookin' for corresponding u unit */
  3674.         FOR_ALL_LINKS(link_ptr->to, link_ptr_u) {
  3675.         if (link_ptr_u->to->lln == ART2_U_LAY) {
  3676.             link_ptr->weight =
  3677.             ART2_ADJUST_LINK_P_REC(link_ptr_u->to, param_d);
  3678.  
  3679.             break;
  3680.         }/* if */
  3681.         }/* FOR_ALL_LINKS */
  3682.     }/* if */
  3683.     }/* FOR_ALL_LINKS */
  3684.  
  3685.  
  3686.     return (ret_code);
  3687.  
  3688. }/* adjust_ART2_weights () */
  3689.  
  3690.  
  3691.  
  3692. /*****************************************************************************
  3693.  *****************************************************************************
  3694.  
  3695.   GROUP        : ARTMAP learning function
  3696.  
  3697.   AUTHOR       : Kai-Uwe Herrmann
  3698.  
  3699.   DATE         : 01.08.1992
  3700.   LAST CHANGE  : 06.11.1993
  3701.  
  3702.              Copyright (c) 1990-1994  SNNS Group, IPVR, Univ. Stuttgart, FRG
  3703.              
  3704. ******************************************************************************
  3705. ******************************************************************************/
  3706.  
  3707.  
  3708.  
  3709. /*****************************************************************************
  3710.   FUNCTION : LEARN_ARTMAP
  3711.  
  3712.   PURPOSE  : ARTMAP learning function.
  3713.   RETURNS  : kernel error code
  3714.   NOTES    : Parameters:      
  3715.                     3 input-parameter  :  1. vigilance parameter RHOa
  3716.                                           2. vigilance parameter RHOb
  3717.                                           3. vigilance parameter RHO
  3718.  
  3719.                     output-parameters  :  none
  3720.  
  3721.   UPDATE   : 06.11.1993 by Guenter Mamier
  3722. ******************************************************************************/
  3723. krui_err LEARN_ARTMAP(int start_pattern, int end_pattern,
  3724.               float parameterInArray[], int NoOfInParams,
  3725.               float **parameterOutArray, int *NoOfOutParams)
  3726. {
  3727.     krui_err        ret_code = KRERR_NO_ERROR;
  3728.     int             pattern_no, sub_pat_no; /* Contains actual pattern number */
  3729.     int             i,n;
  3730.     struct Unit    *winner_ptr_a;    /* recognition unit which is the
  3731.                        winner of w.t.a ARTa */
  3732.     struct Unit    *winner_ptr_b;    /* recognition unit which is the
  3733.                        winner of w.t.a ARTb */
  3734.     struct Unit    *unit_ptr;
  3735.     TopoPtrArray    topo_layer[14];    /* topo_layer[0] : *first input unit
  3736.                        ARTa topo_layer[1] : *first comp.
  3737.                        unit ARTa topo_layer[2] : *first
  3738.                        rec.  unit ARTa topo_layer[3] :
  3739.                        *first delay unit ARTa
  3740.                        topo_layer[4] : *first local reset
  3741.                        unit ARTa topo_layer[5] : *first
  3742.                        special unit ARTa
  3743.                        (classified_unit) topo_layer[6] :
  3744.                        *first input unit ARTb
  3745.                        topo_layer[7] : *first comp. unit
  3746.                        ARTb topo_layer[8] : *first rec.
  3747.                        unit ARTb topo_layer[9] : *first
  3748.                        delay unit ARTb topo_layer[10]:
  3749.                        *first local reset unit ARTb
  3750.                        topo_layer[11]: *first special
  3751.                        unit ARTb (classified_unit)
  3752.                        topo_layer[12]: *first map unit
  3753.                        topo_layer[13]: *first special map
  3754.                        unit */
  3755.  
  3756.     TopoPtrArray    topo_ptr;
  3757.     FlintType       beta_a;
  3758.     FlintType       beta_b;
  3759.     float           rho_a;
  3760.     float           rho_b;
  3761.     float           rho;
  3762.     int             start, end;
  3763.  
  3764.  
  3765.     /* Check number of incoming parameters */
  3766.  
  3767.     if (NoOfInParams < 3) {
  3768.     ret_code = KRERR_PARAMETERS;
  3769.     return (ret_code);
  3770.     }/* if */
  3771.     /* rho is the vigilance parameter */
  3772.     rho_a = parameterInArray[0];
  3773.     rho_b = parameterInArray[1];
  3774.     rho = parameterInArray[2];
  3775.  
  3776.  
  3777.     /* Check interval in which vigilance parameter and constant value L have
  3778.        to be */
  3779.  
  3780.     if ((rho_a < 0.0) || (rho_a > 1.0) || (rho_b < 0.0) ||
  3781.     (rho_b > 1.0) || (rho < 0.0) || (rho > 1.0)
  3782.     ) {
  3783.     ret_code = KRERR_PARAMETERS;
  3784.     return (ret_code);
  3785.     }/* if */
  3786.     /* Check if network has been modified or learning func has been changed */
  3787.     if (NetModified || LearnFuncHasChanged || (TopoSortID != ARTMAP_TOPO_TYPE)){
  3788.     (void) kr_topoSort(ARTMAP_TOPO_TYPE);
  3789.     ret_code = KernelErrorCode;
  3790.     if (ret_code != KRERR_NO_ERROR) {
  3791.         NetModified = TRUE;
  3792.         return (ret_code);
  3793.     }/* if */
  3794.     NetModified = FALSE;
  3795.     LearnFuncHasChanged = FALSE;
  3796.     }/* if */
  3797.  
  3798.     /* set initial activation values */
  3799.     ret_code = kram_init_i_act(rho_a, rho_b, rho);
  3800.  
  3801.     if (ret_code != KRERR_NO_ERROR) {
  3802.     return (ret_code);
  3803.     }/* if */
  3804.     /* beta_a, beta_b are other learning parameters of the network which are
  3805.        determined when initializing the network. They are there written to
  3806.        the bias field of the structure of each unit of the corresponding ART
  3807.        1 network. Now we will read these values. */
  3808.  
  3809.     /* find an ARTa unit and get ARTa beta value */
  3810.     for (unit_ptr=unit_array+1; unit_ptr->lln != ARTMAP_INPa_LAY; unit_ptr++);
  3811.     beta_a = unit_ptr->bias;
  3812.  
  3813.     /* find an ARTb unit and get ARTb beta value */
  3814.     for (unit_ptr=unit_array+1; unit_ptr->lln != ARTMAP_INPb_LAY; unit_ptr++);
  3815.     beta_b = unit_ptr->bias;
  3816.  
  3817.     if ((beta_a <= 0.0) || (beta_b <= 0.0)) {
  3818.     topo_msg.error_code = KRERR_PARAM_BETA;
  3819.     topo_msg.src_error_unit = 0;
  3820.     topo_msg.dest_error_unit = 1;
  3821.     return (topo_msg.error_code);
  3822.     }/* if */
  3823.  
  3824.     /* # of output parameters is 0 */
  3825.     *NoOfOutParams = 0;
  3826.     *parameterOutArray = NULL;
  3827.  
  3828.  
  3829.     /* get pointers to first elements of each layer in topo_ptr_array */
  3830.  
  3831.     topo_ptr = topo_ptr_array + 1;
  3832.  
  3833.     for (i = 0; i <= 13; i++) {
  3834.     topo_layer[i] = topo_ptr;
  3835.     do {
  3836.     } while (*topo_ptr++ != NULL);
  3837.  
  3838.     }/* for */
  3839.  
  3840.  
  3841.     /* compute the necessary sub patterns */
  3842.  
  3843.     KernelErrorCode = kr_initSubPatternOrder(start_pattern,end_pattern);
  3844.     if(KernelErrorCode != KRERR_NO_ERROR)
  3845.     return (KernelErrorCode);
  3846.  
  3847.  
  3848.     /* Search phase */
  3849.     start = kr_AbsPosOfFirstSubPat(start_pattern);
  3850.     end   = kr_AbsPosOfFirstSubPat(end_pattern);
  3851.     end  += kr_NoOfSubPatPairs(end_pattern) - 1;
  3852.  
  3853.     for(n=start; n<=end; n++){
  3854.  
  3855.     kr_getSubPatternByNo(&pattern_no,&sub_pat_no,n);
  3856.  
  3857.     /* initialize the unit activations of the whole net */
  3858.     ret_code = krart_reset_activations();
  3859.     if (ret_code != KRERR_NO_ERROR) {
  3860.         return (ret_code);
  3861.     }/* if */
  3862.  
  3863.     /* put pattern into input units */
  3864.     ret_code = 
  3865.         put_ARTMAP_in_pattern(pattern_no, sub_pat_no, topo_layer[0], 
  3866.                   topo_layer[6]);
  3867.     if (ret_code != KRERR_NO_ERROR) {
  3868.         return (ret_code);
  3869.     }/* if */
  3870.     /* repeat synchronous propagation and look for winner until pattern
  3871.        is classified or network tells us, that pattern is not
  3872.        classifiable */
  3873.     do {
  3874.  
  3875.         /* 1 propagation step (all units push their information onto
  3876.            their output and calculate their new activation. */
  3877.  
  3878.         krart_prop_synch();
  3879.  
  3880.         /* look for the recognition unit with the highest activation
  3881.            returns a NULL pointer if all recognition units have
  3882.            activation 0.0 */
  3883.         winner_ptr_a = krart_get_winner(topo_layer[2], 1.0);
  3884.         winner_ptr_b = krart_get_winner(topo_layer[8], 1.0);
  3885.  
  3886.     } while (!(ARTMAP_CLASSIFIED) && !(ARTMAP_NOT_CLASSIFIABLE));
  3887.  
  3888.  
  3889.     /* training phase */
  3890.  
  3891.     if (ARTMAP_CLASSIFIED) {
  3892.  
  3893.         /* Train network i.e. adjust weights between comparison layer and
  3894.            winner_unit and vice versa of both, ARTa and ARTb. Further
  3895.            adjust weights between ARTa delay and map field layer. */
  3896.  
  3897.         ret_code = adjust_ARTMAP_weights(beta_a, beta_b,
  3898.                          topo_layer[1], topo_layer[7],
  3899.                          topo_layer[3], topo_layer[9],
  3900.                          topo_layer[12],
  3901.                          winner_ptr_a, winner_ptr_b);
  3902.  
  3903.         if (ret_code != KRERR_NO_ERROR) {
  3904.         return (ret_code);
  3905.         }/* if */
  3906.     } else {
  3907.  
  3908.         /* we're doing nothing */
  3909.  
  3910.     }/* if */
  3911.  
  3912.     }/* for */
  3913.  
  3914.     return (ret_code);
  3915.  
  3916. }/* LEARN_ARTMAP */
  3917.  
  3918.  
  3919.  
  3920. /*****************************************************************************
  3921.   FUNCTION : put_ARTMAP_in_pattern
  3922.  
  3923.   PURPOSE  : pushes a new pattern into the input units of the network
  3924.   RETURNS  : kernel error code
  3925.   NOTES    :
  3926.  
  3927.   UPDATE   : 06.11.1993 by Guenter Mamier
  3928. ******************************************************************************/
  3929. static krui_err put_ARTMAP_in_pattern(int pattern_no, int sub_pat_no,
  3930.                       TopoPtrArray topo_inpa_ptr,
  3931.                       TopoPtrArray topo_inpb_ptr)
  3932. {
  3933.     int               ret_code = KRERR_NO_ERROR;
  3934.     register Patterns in_pat;
  3935.     struct Unit       *unit_ptr;
  3936.     TopoPtrArray      topo_ptr_a = topo_inpa_ptr;
  3937.     TopoPtrArray      topo_ptr_b = topo_inpb_ptr;
  3938.  
  3939.  
  3940.     /* calculate startadress of actual pattern */
  3941.     in_pat = kr_getSubPatData(pattern_no,sub_pat_no,INPUT,NULL);
  3942.  
  3943.     while ((unit_ptr = *topo_ptr_a++) != NULL) {
  3944.     if (unit_ptr->out_func == OUT_IDENTITY) {
  3945.         unit_ptr->act = unit_ptr->Out.output = *in_pat++;
  3946.     } else {
  3947.         unit_ptr->act = *in_pat++;
  3948.         unit_ptr->Out.output = (*unit_ptr->out_func) (unit_ptr->act);
  3949.     }/* if */
  3950.     }/* while */
  3951.  
  3952.     while ((unit_ptr = *topo_ptr_b++) != NULL) {
  3953.     if (unit_ptr->out_func == OUT_IDENTITY) {
  3954.         unit_ptr->act = unit_ptr->Out.output = *in_pat++;
  3955.     } else {
  3956.         unit_ptr->act = *in_pat++;
  3957.         unit_ptr->Out.output = (*unit_ptr->out_func) (unit_ptr->act);
  3958.     }/* if */
  3959.     }/* while */
  3960.  
  3961.  
  3962.     return (ret_code);
  3963.  
  3964. }/* put_ARTMAP_in_pattern */
  3965.  
  3966.  
  3967.  
  3968.  
  3969. /*****************************************************************************
  3970.   FUNCTION : adjust_ARTMAP_weights
  3971.  
  3972.   PURPOSE  : training function for ARTMAP networks
  3973.   RETURNS  : kernel error code
  3974.   NOTES    : Parameters:  
  3975.              beta_a         constant value beta of ARTa > 0.0
  3976.              beta_b         constant value beta of ARTb > 0.0
  3977.  
  3978.              compa_ptr      points to pointer to 1st comparison unit of ARTa
  3979.              compb_ptr      points to pointer to 1st comparison unit of ARTb
  3980.  
  3981.              dela_ptr       points to pointer to first unit in the delay layer.
  3982.                         The t(j,i) links are not between recognition layer
  3983.                 and comparison layer but between the respective 
  3984.                 delay unit of the recogniton unit and the 
  3985.                 comparison layer. So first we have to look for the 
  3986.                 corresponding delay unit of the winning unit before
  3987.                 training these weights.
  3988.              delb_ptr       points to pointer to first unit in the delay layer.
  3989.                         The t(j,i) links are not between recognition layer 
  3990.                 and comparison layer but between the respective 
  3991.                 delay unit of the recogniton unit and the 
  3992.                 comparison layer. So first we have to look for the 
  3993.                 corresponding delay unit of the winning unit before
  3994.                 training these weights.
  3995.  
  3996.              map_ptr        points to pointer to first unit in the map layer
  3997.  
  3998.              winner_ptr_a   points to winning unit of the recognition layer of 
  3999.                         ARTa.
  4000.              winner_ptr_b   points to winning unit of the recognition layer of 
  4001.                         ARTb.
  4002.  
  4003.  
  4004.   UPDATE   : 06.11.1993 by Guenter Mamier
  4005. ******************************************************************************/
  4006. static krui_err adjust_ARTMAP_weights(double beta_a, double beta_b,
  4007.                       TopoPtrArray compa_ptr,
  4008.                       TopoPtrArray compb_ptr,
  4009.                       TopoPtrArray dela_ptr,
  4010.                       TopoPtrArray delb_ptr,
  4011.                       TopoPtrArray map_ptr,
  4012.                       struct Unit * winner_ptr_a,
  4013.                       struct Unit * winner_ptr_b)
  4014. {
  4015.     krui_err        ret_code = KRERR_NO_ERROR;
  4016.     TopoPtrArray    topo_ptr = NULL;
  4017.     struct Unit    *unit_ptr_compa = NULL, *unit_ptr_compb = NULL, 
  4018.                    *unit_ptr_dela = NULL, *unit_ptr_delb = NULL, 
  4019.                    *unit_ptr_map = NULL;
  4020.  
  4021.     struct Link    *link_ptr = NULL;
  4022.  
  4023.     bool            found_dela_unit = FALSE;
  4024.     bool            found_delb_unit = FALSE;
  4025.  
  4026.     FlintType       sum_ck = 0.0;
  4027.  
  4028.  
  4029.     if ((winner_ptr_a == NULL) || (winner_ptr_b == NULL)) {
  4030.     /* We are using ARTMAP in a non-learning mode, wo we are not allowed
  4031.        to adjust weights now. Weights may just be adjusted, if we have an
  4032.        input in ARTa and ARTb each of which brings out a winner in the
  4033.        respective F2-Layer */
  4034.     return (ret_code);
  4035.     }/* if */
  4036.     /* get corresponding unit of the winning unit of ARTa in the delay layer */
  4037.     topo_ptr = dela_ptr;
  4038.  
  4039.     while ((!found_dela_unit) && (*topo_ptr != NULL)) {
  4040.     unit_ptr_dela = *topo_ptr++;
  4041.     FOR_ALL_LINKS(unit_ptr_dela, link_ptr) {
  4042.         if (link_ptr->to == winner_ptr_a) {
  4043.         found_dela_unit = TRUE;
  4044.         }/* if */
  4045.     }/* FOR_ALL_LINKS */
  4046.     }/* while */
  4047.  
  4048.     /* get corresponding unit of the winning unit of ARTb in the delay layer */
  4049.  
  4050.     topo_ptr = delb_ptr;
  4051.     while ((!found_delb_unit) && (*topo_ptr != NULL)) {
  4052.     unit_ptr_delb = *topo_ptr++;
  4053.     FOR_ALL_LINKS(unit_ptr_delb, link_ptr) {
  4054.         if (link_ptr->to == winner_ptr_b) {
  4055.         found_delb_unit = TRUE;
  4056.         break;
  4057.         }/* if */
  4058.     }/* FOR_ALL_LINKS */
  4059.     }/* while */
  4060.  
  4061.     if ((!found_dela_unit) || (!found_delb_unit)) {
  4062.  
  4063.     /* There was no delay unit found corresponding to the winning
  4064.        recognition unit in ARTa or ARTb */
  4065.  
  4066.     ret_code = KRERR_TOPOLOGY;
  4067.     return (ret_code);
  4068.  
  4069.     }/* if */
  4070.     /********* ADJUST WEIGHTS *********/
  4071.     /* Adjust weights between winning unit (delay-layer) and comparison layer
  4072.        (t(j,i) link values) -> ARTa
  4073.     
  4074.        t(j,i) = c(i)   where j is the number of the winning neuron in the delay
  4075.        layer and i ist the number of a comparison unit. 
  4076.     */
  4077.  
  4078.     topo_ptr = compa_ptr;
  4079.     while ((unit_ptr_compa = *topo_ptr++) != NULL) {
  4080.     sum_ck += unit_ptr_compa->act;    /* sum up activatons of comparison
  4081.                        layer. sum_ck is needed for b(i,j) */
  4082.     FOR_ALL_LINKS(unit_ptr_compa, link_ptr) {
  4083.         if (link_ptr->to == unit_ptr_dela) {
  4084.         link_ptr->weight = ART1_ADJUST_LINK_DEL_CMP(unit_ptr_compa);
  4085.         }/* if */
  4086.     }/* FOR_ALL_LINKS */
  4087.     }/* while */
  4088.  
  4089.     /* Adjust weights between comparison layer and winning unit (recognition
  4090.        layer) -> ARTa
  4091.     
  4092.        b(i,j) = c(i) / (beta + sum(k)(c(k)))
  4093.     
  4094.        where j is the number of the winning neuron in the recognition layer, i
  4095.        ist the number of a comparison unit and k runs over all comparison
  4096.        units. (sum(k)(c(k))) = sum_ck. 
  4097.     */
  4098.  
  4099.     FOR_ALL_LINKS(winner_ptr_a, link_ptr) {
  4100.     if (link_ptr->to->lln == ARTMAP_CMPa_LAY) {
  4101.         link_ptr->weight = (FlintType)ART1_ADJUST_LINK_CMP_REC(link_ptr->to,
  4102.                                    beta_a,
  4103.                                    sum_ck);
  4104.     }/* if */
  4105.     }/* FOR_ALL_LINKS */
  4106.  
  4107.  
  4108.     /* Adjust weights between winning unit (delay-layer) and comparison layer
  4109.        (t(j,i) link values) -> ARTb
  4110.     
  4111.        t(j,i) = c(i)   where j is the number of the winning neuron in the delay
  4112.        layer and i ist the number of a comparison unit. 
  4113.     */
  4114.  
  4115.     topo_ptr = compb_ptr;
  4116.     sum_ck = 0.0;
  4117.     while ((unit_ptr_compb = *topo_ptr++) != NULL) {
  4118.     sum_ck += unit_ptr_compb->act;    /* sum up activatons of comparison
  4119.                        layer. sum_ck is needed for b(i,j) */
  4120.     FOR_ALL_LINKS(unit_ptr_compb, link_ptr) {
  4121.         if (link_ptr->to == unit_ptr_delb) {
  4122.         link_ptr->weight = ART1_ADJUST_LINK_DEL_CMP(unit_ptr_compb);
  4123.         }/* if */
  4124.     }/* FOR_ALL_LINKS */
  4125.     }/* while */
  4126.  
  4127.     /* Adjust weights between comparison layer and winning unit (recognition
  4128.        layer) (b(i,j) link values)
  4129.     
  4130.        b(i,j) = c(i) / (beta + sum(k)(c(k)))
  4131.     
  4132.        where j is the number of the winning neuron in the recognition layer, i
  4133.        ist the number of a comparison unit and k runs over all comparison
  4134.        units. (sum(k)(c(k))) = sum_ck. 
  4135.     */
  4136.  
  4137.     FOR_ALL_LINKS(winner_ptr_b, link_ptr) {
  4138.     if (link_ptr->to->lln == ARTMAP_CMPb_LAY) {
  4139.         link_ptr->weight = (FlintType)ART1_ADJUST_LINK_CMP_REC(link_ptr->to,
  4140.                                    beta_b,
  4141.                                    sum_ck);
  4142.     }/* if */
  4143.     }/* FOR_ALL_LINKS */
  4144.  
  4145.  
  4146.     /* Adjust weights between delay units of ARTa and map units
  4147.     
  4148.        w(i,j) = map(j) where j is the number of a neuron in the map layer i is
  4149.        the number of the winning neuron in the dela layer 
  4150.     */
  4151.  
  4152.     topo_ptr = map_ptr;
  4153.     while ((unit_ptr_map = *topo_ptr++) != NULL) {
  4154.     FOR_ALL_LINKS(unit_ptr_map, link_ptr) {
  4155.         if (link_ptr->to == unit_ptr_dela) {
  4156.         /* Same as adjustment between delay and comparison layer */
  4157.         link_ptr->weight = ART1_ADJUST_LINK_DEL_CMP(unit_ptr_map);
  4158.         }/* if */
  4159.     }/* FOR_ALL_LINKS */
  4160.     }/* while */
  4161.  
  4162.     return (ret_code);
  4163.  
  4164. }/* adjust_ARTMAP_weights () */
  4165.  
  4166.  
  4167.  
  4168. /*****************************************************************************
  4169.  *****************************************************************************
  4170.  
  4171.   GROUP        : backpropagation through time learning functions
  4172.  
  4173.   AUTHOR       : Martin Reczko
  4174.   NOTES        : Implemented are Truncated backpropagation through time with 
  4175.                  online-update (BPTT), Truncated backpropagation through time 
  4176.                  with batch-update (BBPTT) and truncated quickprop through 
  4177.          time (QPTT) learning functions
  4178.  
  4179.   DATE         : 01.08.1992
  4180.   LAST CHANGE  : 06.11.1993
  4181.  
  4182.              Copyright (c) 1990-1994  SNNS Group, IPVR, Univ. Stuttgart, FRG
  4183.              
  4184. ******************************************************************************
  4185. ******************************************************************************/
  4186.  
  4187.  
  4188. /*****************************************************************************
  4189.   FUNCTION : BPTT_clear_deltaw
  4190.  
  4191.   PURPOSE  : BPTT weight change reset
  4192.   RETURNS  : kernel error code
  4193.   NOTES    :
  4194.  
  4195.   UPDATE   : 06.11.1993 by Guenter Mamier
  4196. ******************************************************************************/
  4197. static krui_err BPTT_clear_deltaw(void)
  4198. {
  4199.     register struct Unit *unit_ptr;
  4200.     struct Link    *link_ptr;
  4201.  
  4202.  
  4203.     FOR_ALL_UNITS(unit_ptr) {
  4204.  
  4205.     /* reset old weight changes (_a), old gradients (_b) and gradient
  4206.        accumulators (_c) */
  4207.     unit_ptr->value_a = 0.0;
  4208.     unit_ptr->value_b = 0.0;
  4209.     unit_ptr->value_c = 0.0;
  4210.     FOR_ALL_LINKS(unit_ptr, link_ptr) {
  4211.         link_ptr->value_a = 0.0;
  4212.         link_ptr->value_b = 0.0;
  4213.         link_ptr->value_c = 0.0;
  4214.     }
  4215.     }
  4216.     return (KRERR_NO_ERROR);
  4217. }
  4218.  
  4219.  
  4220.  
  4221. /*****************************************************************************
  4222.   FUNCTION : initializeBPTT 
  4223.  
  4224.   PURPOSE  : BPTT network activity reset 
  4225.   RETURNS  : kernel error code
  4226.   NOTES    : BPTT data structures: unit:
  4227.              unit_ptr->olddelta : delta values, after finished calculation 
  4228.                               for 1 time step
  4229.              unit_ptr->newdelta : accumulators for new delta values
  4230.  
  4231.   UPDATE   : 06.11.1993 by Guenter Mamier
  4232. ******************************************************************************/
  4233. static krui_err initializeBPTT(void)
  4234. {
  4235.     register struct Unit *unit_ptr;
  4236.     int             i;
  4237.  
  4238.     FOR_ALL_UNITS(unit_ptr) {
  4239.     /* clear netact-copies */
  4240.     for (i = 0; i < MAX_BPTT_BACKSTEP; i++)
  4241.         unit_ptr->actbuf[i] = 0.0;
  4242.     }
  4243.     return (KRERR_NO_ERROR);
  4244. }
  4245.  
  4246.  
  4247.  
  4248. /*****************************************************************************
  4249.   FUNCTION : BPTT_propagateNetForward
  4250.  
  4251.   PURPOSE  : topological forward propagation (backprop thru time)
  4252.   RETURNS  : 
  4253.   NOTES    :
  4254.  
  4255.   UPDATE   : 06.11.1993 by Guenter Mamier
  4256. ******************************************************************************/
  4257. static void BPTT_propagateNetForward(int pattern_no, int sub_pat_no, int nhist)
  4258. {
  4259.     register struct Unit *unit_ptr;
  4260.     register Patterns in_pat;
  4261.     register TopoPtrArray topo_ptr;
  4262.     TopoPtrArray    first_hidden_ptr;
  4263.     int             i, done_hidden;
  4264.     int             all_zero_input = 1;    /* flag to reset net-copies */
  4265.  
  4266.     /* calculate startaddress for input pattern array  */
  4267.     in_pat = kr_getSubPatData(pattern_no,sub_pat_no,INPUT,NULL);
  4268.  
  4269.     topo_ptr = topo_ptr_array;
  4270.  
  4271.     /* ACTIVATE INPUT LAYER */
  4272.     /* copy pattern into input unit's activation and calculate output of the
  4273.        input units */
  4274.     /* topo_ptr points to a (topological sorted) unit stucture (input units
  4275.        first)  */
  4276.     while ((unit_ptr = *++topo_ptr) != NULL){
  4277.  
  4278.     /* apply input pattern */
  4279.     if (unit_ptr->out_func == OUT_IDENTITY)
  4280.         /* there is no need to call the output function  */
  4281.         unit_ptr->Out.output = unit_ptr->act = *in_pat++;
  4282.     else
  4283.         /* no identity output function: calculate unit's output also  */
  4284.         unit_ptr->Out.output = 
  4285.         (*unit_ptr->out_func) (unit_ptr->act = *in_pat++);
  4286.     if (fabs(unit_ptr->act) > 0.000001)
  4287.         all_zero_input = 0;    /* no reset-input */
  4288.  
  4289.     /* BPTT: shift the actbuf for this input buffer one step back in time */
  4290.     for (i = nhist; i > 0; i--) {
  4291.         unit_ptr->actbuf[i] = unit_ptr->actbuf[i - 1];
  4292.     }
  4293.  
  4294.     /* the new input pattern moves into the second time-layer with index 1,
  4295.        since activations for this pattern are calculated in time-layer 0 */
  4296.     unit_ptr->actbuf[1] = unit_ptr->act;
  4297.  
  4298.     }
  4299.  
  4300.     /* An all-zero input pattern resets all network activities */
  4301.     if (all_zero_input) {
  4302.     initializeBPTT();    /* reset all netact-copies at start of sequences */
  4303.     }
  4304.  
  4305.     /* INPUT LAYER DONE */
  4306.  
  4307.     /* store first hidden unit pointer */
  4308.     first_hidden_ptr = topo_ptr;
  4309.  
  4310.     /* shift all actbufs for non-input units one step back in time, make most
  4311.        recent activity visible in unit_ptr->Out.output for subsequent calls
  4312.        to act_func */
  4313.     while ((unit_ptr = *++topo_ptr) != NULL) {    /* hidden layer */
  4314.     for (i = nhist; i > 0; i--)
  4315.         unit_ptr->actbuf[i] = unit_ptr->actbuf[i - 1];
  4316.     unit_ptr->Out.output = unit_ptr->actbuf[1];
  4317.     }
  4318.  
  4319.     while ((unit_ptr = *++topo_ptr) != NULL) {    /* output layer */
  4320.     for (i = nhist; i > 0; i--)
  4321.         unit_ptr->actbuf[i] = unit_ptr->actbuf[i - 1];
  4322.     unit_ptr->Out.output = unit_ptr->actbuf[1];
  4323.     }
  4324.  
  4325.  
  4326.     /* calculate new activities for hidden and output units */
  4327.     /* point to first hidden unit */
  4328.     topo_ptr = first_hidden_ptr;
  4329.     done_hidden = 0;
  4330.     while (((unit_ptr = *++topo_ptr) != NULL) || (done_hidden == 0))
  4331.     if (unit_ptr == NULL) {
  4332.         done_hidden = 1;
  4333.     } else {
  4334.         /* calc actbuf[0] using actbuf[1], don't update Out.output while
  4335.            updating units, wait until all units are processed  */
  4336.         unit_ptr->act = (*unit_ptr->act_func) (unit_ptr);
  4337.         unit_ptr->actbuf[0] = unit_ptr->act;
  4338.     }
  4339.  
  4340.     /* set Out.output */
  4341.     topo_ptr = first_hidden_ptr;
  4342.     done_hidden = 0;
  4343.     while (((unit_ptr = *++topo_ptr) != NULL) || (done_hidden == 0))
  4344.     if (unit_ptr == NULL) {
  4345.         done_hidden = 1;
  4346.     } else {
  4347.         if (unit_ptr->out_func == OUT_IDENTITY)
  4348.         /* identity output function: there is no need to call the
  4349.            output function  */
  4350.         unit_ptr->Out.output = unit_ptr->act;
  4351.         else
  4352.         /* no identity output function: calculate unit's output also  */
  4353.         unit_ptr->Out.output = (*unit_ptr->out_func) (unit_ptr->act);
  4354.     }
  4355. }
  4356.  
  4357.  
  4358. /*****************************************************************************
  4359.   FUNCTION : initOldDeltas
  4360.  
  4361.   PURPOSE  :
  4362.   RETURNS  : 
  4363.   NOTES    : BPTT starts at the first time-layer (actbuf[0]).
  4364.              The deltas for this layer are calculated for the output units by
  4365.          comparison with the target values. All other deltas for hidden 
  4366.          units are zero. The deltas are propagated to the second time-layer
  4367.          (actbuf[1]) into oldelta
  4368.  
  4369.   UPDATE   : 06.11.1993 by Guenter Mamier
  4370. ******************************************************************************/
  4371. static float initOldDeltas(int pattern_no, int sub_pat_no)
  4372. {
  4373.     register struct Link *link_ptr;
  4374.     register struct Unit *unit_ptr;
  4375.     register Patterns out_pat;
  4376.     register float  error, sum_error, devit, delta, tmp;
  4377.     register TopoPtrArray topo_ptr;
  4378.     TopoPtrArray    first_hidden_ptr;
  4379.     int             all_correct = 1;    /* flag, wether all bits in the
  4380.                        pattern are correct */
  4381.     int size;
  4382.  
  4383.     /* Initdelta, Step 1: clear all olddeltas (accumulate delta in olddelta) */
  4384.  
  4385.     topo_ptr = topo_ptr_array;
  4386.     while ((unit_ptr = *++topo_ptr) != NULL) {    /* input units */
  4387.     unit_ptr->olddelta = 0.0;
  4388.     }
  4389.  
  4390.     /* store first hidden unit pointer */
  4391.     first_hidden_ptr = topo_ptr;
  4392.     while ((unit_ptr = *++topo_ptr) != NULL) {    /* hidden units */
  4393.     unit_ptr->olddelta = 0.0;
  4394.     }
  4395.  
  4396.     while ((unit_ptr = *++topo_ptr) != NULL) {    /* output units */
  4397.     unit_ptr->olddelta = 0.0;
  4398.     }
  4399.  
  4400.     sum_error = 0.0;        /* reset network error  */
  4401.  
  4402.     /* calculate address of the output pattern (with number pattern_no + 1)  */
  4403.     out_pat = kr_getSubPatData(pattern_no,sub_pat_no,OUTPUT,&size);
  4404.     out_pat += size;
  4405.  
  4406.  
  4407.     /* last output unit: add 3 to no_of_topo_units because the topologic
  4408.        array contains 4 NULL pointers  */
  4409.     topo_ptr = topo_ptr_array + (no_of_topo_units + 3);
  4410.  
  4411.     /* LOOP FOR ALL OUTPUT UNITS */
  4412.     /* calculate olddelta for output units  */
  4413.     while ((unit_ptr = *--topo_ptr) != NULL) {
  4414.     tmp = unit_ptr->Out.output;
  4415.     devit = *(--out_pat);
  4416.  
  4417.     /* count correct bits using threshold of 0.5 */
  4418.     if (devit > 0.5) {
  4419.         if (tmp > 0.5)
  4420.         NoOfLearnedPatterns++;
  4421.         else
  4422.         all_correct = 0;
  4423.     } else {
  4424.         if (tmp <= 0.5)
  4425.         NoOfLearnedPatterns++;
  4426.         else
  4427.         all_correct = 0;
  4428.     }
  4429.  
  4430.     devit = devit - tmp;    /* calc. devitation (target_j - output_j) */
  4431.     error = devit * devit;
  4432.     sum_error += error;
  4433.  
  4434.     /* BPTT uses sum_j ( o_j - t_j )^2 as error function => -2.0 * ... */
  4435.     delta = -2.0 * devit * ((unit_ptr->act_deriv_func) (unit_ptr));
  4436.  
  4437.     /* Initdelta, Step 2: upstream propagation of gradients for backprop */
  4438.     FOR_ALL_LINKS(unit_ptr, link_ptr) {
  4439.         tmp = delta * link_ptr->weight;
  4440.         link_ptr->to->olddelta += tmp;    /* accumulate delta */
  4441.         /* accumulate weight gradient */
  4442.         link_ptr->value_c += link_ptr->to->actbuf[1] * delta;    
  4443.     }
  4444.  
  4445.     /* accumulate bias gradient */
  4446.     unit_ptr->value_c += delta;
  4447.     }/* output units done */
  4448.  
  4449.     /* Initdelta, Step 3:  clear newdelta */
  4450.     topo_ptr = topo_ptr_array;
  4451.     while ((unit_ptr = *++topo_ptr) != NULL) {    /* input units */
  4452.     unit_ptr->newdelta = 0.0;
  4453.     }
  4454.  
  4455.     while ((unit_ptr = *++topo_ptr) != NULL) {    /* hidden units */
  4456.     unit_ptr->newdelta = 0.0;
  4457.     }
  4458.  
  4459.     while ((unit_ptr = *++topo_ptr) != NULL) {    /* output units */
  4460.     unit_ptr->newdelta = 0.0;
  4461.     }
  4462.  
  4463.     return (sum_error);
  4464. }
  4465.  
  4466.  
  4467. /*****************************************************************************
  4468.   FUNCTION : oneStepBackprop
  4469.  
  4470.   PURPOSE  : calc weight changes between consecutive time steps 
  4471.   RETURNS  : network error
  4472.   NOTES    : heart of BPTT
  4473.  
  4474.   UPDATE   : 06.11.1993 by Guenter Mamier
  4475. ******************************************************************************/
  4476. static float oneStepBackprop(int backstep, int pattern_no, int sub_pat_no, 
  4477.                  int nhist)
  4478. {
  4479.     register struct Link *link_ptr;
  4480.     register struct Unit *unit_ptr;
  4481.     double          delta, sum_error;
  4482.     register TopoPtrArray topo_ptr;
  4483.     int             done_hidden, nextlayer;
  4484.     float           tmp;
  4485.  
  4486.     /* CHECK FOR START OF BACKPROP AT THE LAST TIME LAYER */
  4487.     if (backstep == 0) {
  4488.     sum_error = initOldDeltas(pattern_no,sub_pat_no);
  4489.     return (sum_error);    /* start case */
  4490.     } else            /* at least for time layer 0, old deltas are
  4491.                    known */
  4492.     sum_error = 0.0;
  4493.  
  4494.     /* index of next layer (used frequently!) */
  4495.     nextlayer = backstep + 1;
  4496.  
  4497.     /* point to seperator after last input unit */
  4498.     topo_ptr = topo_ptr_array;    /* + (NoOfInputUnits + 1); */
  4499.     while ((unit_ptr = *++topo_ptr) != NULL);
  4500.     done_hidden = 0;
  4501.  
  4502.     /* DO BACKPROP FOR ALL NON-INPUT-UNITS */
  4503.     while (((unit_ptr = *++topo_ptr) != NULL) || (done_hidden == 0))
  4504.     if (unit_ptr == NULL) {    /* skip NULL seperator between hidden and
  4505.                    output units */
  4506.         done_hidden = 1;
  4507.     } else {        /* delta =  f'(net[backstep]) * olddelta */
  4508.         /* copy actbuf[backstep] to act to enable call to act_deriv_func
  4509.            (overhead: better definition of activation functions required) */
  4510.         unit_ptr->act = unit_ptr->actbuf[backstep];
  4511.         delta = ((unit_ptr->act_deriv_func)(unit_ptr)) * unit_ptr->olddelta;
  4512.  
  4513.         /* propagate gradients upstream */
  4514.         FOR_ALL_LINKS(unit_ptr, link_ptr) {
  4515.         tmp = delta * link_ptr->weight;
  4516.         link_ptr->to->newdelta += tmp;    /* accumulate delta */
  4517.         /* accumulate weight gradient */
  4518.         link_ptr->value_c += link_ptr->to->actbuf[nextlayer] * delta;
  4519.         }
  4520.  
  4521.         /* accumulate bias gradient */
  4522.         unit_ptr->value_c += delta;
  4523.     }
  4524.  
  4525.     /* copy newdeltas to olddeltas, clear newdeltas */
  4526.     topo_ptr = topo_ptr_array;
  4527.     while ((unit_ptr = *++topo_ptr) != NULL) {    /* input units */
  4528.     unit_ptr->olddelta = unit_ptr->newdelta;
  4529.     unit_ptr->newdelta = 0.0;
  4530.     }
  4531.  
  4532.     while ((unit_ptr = *++topo_ptr) != NULL) {    /* hidden units */
  4533.     unit_ptr->olddelta = unit_ptr->newdelta;
  4534.     unit_ptr->newdelta = 0.0;
  4535.     }
  4536.  
  4537.     while ((unit_ptr = *++topo_ptr) != NULL) {    /* output units */
  4538.     unit_ptr->olddelta = unit_ptr->newdelta;
  4539.     unit_ptr->newdelta = 0.0;
  4540.     }
  4541.  
  4542.     return (sum_error);
  4543. }
  4544.  
  4545.  
  4546.  
  4547. /*****************************************************************************
  4548.   FUNCTION : BPTTadapt 
  4549.  
  4550.   PURPOSE  : adapt all weights after BPTT using steepest descent with momentum
  4551.   RETURNS  : 
  4552.   NOTES    :
  4553.  
  4554.   UPDATE   : 06.11.1993 by Guenter Mamier
  4555. ******************************************************************************/
  4556. static void BPTTadapt(float step_size, float bptt_momentum)
  4557. {
  4558.     register struct Link *link_ptr;
  4559.     register struct Unit *unit_ptr;
  4560.     register TopoPtrArray topo_ptr;
  4561.     int             done_hidden = 0;
  4562.     float           delta;
  4563.  
  4564.     /* point to seperator after last input unit */
  4565.     topo_ptr = topo_ptr_array + (NoOfInputUnits + 1);
  4566.  
  4567.     /* for each non-input unit: add weight changes to old weights */
  4568.     while (((unit_ptr = *++topo_ptr) != NULL) || (done_hidden == 0)) {
  4569.     if (unit_ptr == NULL) {
  4570.         done_hidden = 1;
  4571.     } else {
  4572.         delta = step_size * (-unit_ptr->value_c) + 
  4573.         bptt_momentum * unit_ptr->value_a;
  4574.         if (!IS_SPECIAL_UNIT(unit_ptr))
  4575.         unit_ptr->bias += delta;
  4576.         unit_ptr->value_a = delta;
  4577.         unit_ptr->value_c = 0.0;
  4578.         /* set act to last activity, since it was scrambled by bptt */
  4579.         unit_ptr->act = unit_ptr->Out.output;
  4580.         FOR_ALL_LINKS(unit_ptr, link_ptr) {
  4581.         delta = step_size * (-link_ptr->value_c) + 
  4582.             bptt_momentum * link_ptr->value_a;
  4583.         link_ptr->value_a = delta;
  4584.         link_ptr->value_c = 0.0;
  4585.         }
  4586.         if (!IS_SPECIAL_UNIT(unit_ptr))
  4587.         FOR_ALL_LINKS(unit_ptr, link_ptr) {
  4588.             link_ptr->weight += link_ptr->value_a;
  4589.         }
  4590.     }
  4591.     }
  4592. }
  4593.  
  4594.  
  4595.  
  4596. /*****************************************************************************
  4597.   FUNCTION : BPTT_propagateNetBackward
  4598.  
  4599.   PURPOSE  : BPTT-main: accumulate weight changes backward thru time
  4600.   RETURNS  : network error
  4601.   NOTES    :
  4602.  
  4603.   UPDATE   : 06.11.1993 by Guenter Mamier
  4604. ******************************************************************************/
  4605. static float BPTT_propagateNetBackward(int pattern_no, int sub_pat_no,int nhist)
  4606. {
  4607.     float           error = 0.0;
  4608.     float           dummy;
  4609.     int             backstep;
  4610.  
  4611.     /* go nhist steps back thru time */
  4612.     for (backstep = 0; backstep < nhist; backstep++)
  4613.     if (backstep == 0) {
  4614.         /* start at output, pattern-error is calculated first */
  4615.         error = oneStepBackprop(backstep, pattern_no, sub_pat_no, nhist);
  4616.     } else {
  4617.         dummy = oneStepBackprop(backstep, pattern_no, sub_pat_no, nhist);
  4618.     }
  4619.     return (error);
  4620. }
  4621.  
  4622.  
  4623.  
  4624. /*****************************************************************************
  4625.   FUNCTION : LEARN_BPTT
  4626.  
  4627.   PURPOSE  : Backpropagation through time learning function
  4628.   RETURNS  : kernel error code
  4629.   NOTES    : Input Parameters:   1 : step_size
  4630.                                  2 : momentum
  4631.                  3 : nhist
  4632.              Output Parameters:  1 : error of the network (sum of all cycles)
  4633.  
  4634.  
  4635.   UPDATE   : 06.11.1993 by Guenter Mamier
  4636. ******************************************************************************/
  4637. krui_err LEARN_BPTT(int start_pattern, int end_pattern, 
  4638.             float *parameterInArray, int NoOfInParams, 
  4639.             float **parameterOutArray, int *NoOfOutParams)
  4640. {
  4641.     static float    OutParameter[1];    /* OutParameter[0] stores the
  4642.                        learning error  */
  4643.     int             i, ret_code, pattern_no, sub_pat_no, patterns;
  4644.     int             nhist;    /* number of steps back in time */
  4645.     register struct Unit *unit_ptr;
  4646.  
  4647.     if (NoOfUnits == 0)
  4648.     return (KRERR_NO_UNITS);        /* No Units defined     */
  4649.     if (NoOfInParams < 1)            /* has to be ... snns habit ? */
  4650.     return (KRERR_PARAMETERS);    /* Not enough input parameters  */
  4651.  
  4652.     *NoOfOutParams = 1;        /* One return value is available (the
  4653.                    learning error)  */
  4654.     *parameterOutArray = OutParameter;    /* set the output parameter reference */
  4655.     ret_code = KRERR_NO_ERROR;    /* reset return code  */
  4656.  
  4657.     if (NetModified || (TopoSortID != TOPOLOGIC_TYPE)) {
  4658.     /* Net has been modified or topologic array isn't initialized */
  4659.     /* any connected topology allowed */
  4660.     /* count the no. of I/O units and check the patterns  */
  4661.     ret_code = kr_IOCheck();
  4662.     if (ret_code < KRERR_NO_ERROR)
  4663.         return (ret_code);
  4664.  
  4665.     /* sort units by ''topologic type'', criterion is visibility
  4666.        (input,hidden,output), not topology */
  4667.     ret_code = kr_topoSort(TOPOLOGIC_TYPE);
  4668.  
  4669.     if ((ret_code != KRERR_NO_ERROR) && (ret_code != KRERR_DEAD_UNITS))
  4670.         return (ret_code);
  4671.     /* sites are not supported, check absence */
  4672.     FOR_ALL_UNITS(unit_ptr)
  4673.         if UNIT_HAS_SITES
  4674.         (unit_ptr)
  4675.         return (KRERR_SITES_NO_SUPPORT);
  4676.     NetModified = FALSE;
  4677.     }
  4678.     if (NetInitialize || LearnFuncHasChanged) {    /* Net has been modified or
  4679.                            initialized, clear weight
  4680.                            changes */
  4681.     ret_code = BPTT_clear_deltaw();
  4682.     if (ret_code != KRERR_NO_ERROR)
  4683.         return (ret_code);
  4684.     }
  4685.     NET_ERROR(OutParameter) = 0.0;    /* reset network error value  */
  4686.  
  4687.     NoOfLearnedPatterns = 0;    /* correct bits using threshold of 0.5 */
  4688.     nhist = LEARN_PARAM3(parameterInArray);
  4689.     if (nhist > MAX_BPTT_BACKSTEP)
  4690.     return (KRERR_NET_DEPTH);    /* actbuf and learning functions
  4691.                        support only MAX_BPTT_BACKSTEP net
  4692.                        copies */
  4693.  
  4694.     /* compute the necessary sub patterns */
  4695.  
  4696.     KernelErrorCode = kr_initSubPatternOrder(start_pattern,end_pattern);
  4697.     if(KernelErrorCode != KRERR_NO_ERROR)
  4698.     return (KernelErrorCode);
  4699.  
  4700.     patterns = 0;
  4701.     while(kr_getSubPatternByOrder(&pattern_no,&sub_pat_no)){
  4702.  
  4703.     /* FORWARD-BPTT */
  4704.     /* 1st parameter is the pattern number 2nd parameter is the number of
  4705.        steps back in time */
  4706.     BPTT_propagateNetForward(pattern_no,sub_pat_no,nhist); /*Forward pass */
  4707.  
  4708.     /* Backward propagation  */
  4709.     NET_ERROR(OutParameter) 
  4710.         += BPTT_propagateNetBackward(pattern_no, sub_pat_no, nhist);
  4711.  
  4712.     /* online version: adapt net after each pattern has been
  4713.        backpropagated through time and weight changes have accumulated
  4714.        through time */
  4715.     BPTTadapt(LEARN_PARAM1(parameterInArray), 
  4716.           LEARN_PARAM2(parameterInArray));
  4717.  
  4718.     patterns++;
  4719.     }
  4720.     return (ret_code);
  4721. }
  4722.  
  4723.  
  4724.  
  4725. /*****************************************************************************
  4726.   FUNCTION : LEARN_BBPTT
  4727.  
  4728.   PURPOSE  : Batch backpropagation through time learning function (BBPTT)
  4729.   RETURNS  : 
  4730.   NOTES    : Input Parameters:   1 : step_size
  4731.                                  2 : momentum
  4732.                  3 : nhist
  4733.              Output Parameters:  1 : error of the network (sum of all cycles)
  4734.  
  4735.   UPDATE   : 06.11.1993 by Guenter Mamier
  4736. ******************************************************************************/
  4737. krui_err LEARN_BBPTT(int start_pattern, int end_pattern, 
  4738.              float *parameterInArray, int NoOfInParams, 
  4739.              float **parameterOutArray, int *NoOfOutParams)
  4740. {
  4741.     static float    OutParameter[1];    /* OutParameter[0] stores the
  4742.                        learning error  */
  4743.     int             i, ret_code, pattern_no, sub_pat_no, patterns;
  4744.     int             nhist;    /* number of steps back in time */
  4745.     register struct Unit *unit_ptr;
  4746.  
  4747.     if (NoOfUnits == 0)
  4748.     return (KRERR_NO_UNITS);        /* No Units defined     */
  4749.     if (NoOfInParams < 1)                 /* has to be ... snns habit ? */
  4750.     return (KRERR_PARAMETERS);    /* Not enough input parameters  */
  4751.  
  4752.     *NoOfOutParams = 1;        /* One return value is available (the
  4753.                    learning error)  */
  4754.     *parameterOutArray = OutParameter;    /* set the output parameter reference */
  4755.     ret_code = KRERR_NO_ERROR;    /* reset return code  */
  4756.  
  4757.     if (NetModified || (TopoSortID != TOPOLOGIC_TYPE)) {
  4758.     /* Net has been modified or topologic array isn't initialized */
  4759.     /* any connected topology allowed */
  4760.     /* count the no. of I/O units and check the patterns  */
  4761.     ret_code = kr_IOCheck();
  4762.     if (ret_code < KRERR_NO_ERROR)
  4763.         return (ret_code);
  4764.  
  4765.     /* sort units by ''topologic type'', criterion is visibility
  4766.        (input,hidden,output), not topology */
  4767.     ret_code = kr_topoSort(TOPOLOGIC_TYPE);
  4768.  
  4769.     if ((ret_code != KRERR_NO_ERROR) && (ret_code != KRERR_DEAD_UNITS))
  4770.         return (ret_code);
  4771.     /* sites are not supported, check absence */
  4772.     FOR_ALL_UNITS(unit_ptr)
  4773.         if UNIT_HAS_SITES
  4774.         (unit_ptr)
  4775.         return (KRERR_SITES_NO_SUPPORT);
  4776.     NetModified = FALSE;
  4777.     }
  4778.     if (NetInitialize || LearnFuncHasChanged) {    /* Net has been modified or
  4779.                            initialized, clear weight
  4780.                            changes */
  4781.     ret_code = BPTT_clear_deltaw();
  4782.     if (ret_code != KRERR_NO_ERROR)
  4783.         return (ret_code);
  4784.     }
  4785.     NET_ERROR(OutParameter) = 0.0;    /* reset network error value  */
  4786.  
  4787.     NoOfLearnedPatterns = 0;    /* correct bits using threshold of 0.5 */
  4788.     nhist = LEARN_PARAM3(parameterInArray);
  4789.     if (nhist > MAX_BPTT_BACKSTEP)
  4790.     return (KRERR_NET_DEPTH);    /* actbuf and learning functions
  4791.                        support only MAX_BPTT_BACKSTEP net
  4792.                        copies */
  4793.  
  4794.     /* compute the necessary sub patterns */
  4795.  
  4796.     KernelErrorCode = kr_initSubPatternOrder(start_pattern,end_pattern);
  4797.     if(KernelErrorCode != KRERR_NO_ERROR)
  4798.     return (KernelErrorCode);
  4799.  
  4800.  
  4801.     patterns = 0;
  4802.     while(kr_getSubPatternByOrder(&pattern_no,&sub_pat_no)){
  4803.  
  4804.     /* FORWARD-BPTT */
  4805.     /* 1st parameter is the pattern number 2nd parameter is the number of
  4806.        steps back in time */
  4807.     BPTT_propagateNetForward(pattern_no,sub_pat_no,nhist); /*Forward pass */
  4808.  
  4809.     /* Backward propagation  */
  4810.     NET_ERROR(OutParameter) 
  4811.         += BPTT_propagateNetBackward(pattern_no, sub_pat_no, nhist);
  4812.     patterns++;
  4813.     }
  4814.  
  4815.     /* batch version */
  4816.     BPTTadapt(LEARN_PARAM1(parameterInArray) / patterns, 
  4817.           LEARN_PARAM2(parameterInArray));
  4818.  
  4819.     return (ret_code);
  4820. }
  4821.  
  4822.  
  4823.  
  4824. /*****************************************************************************
  4825.   FUNCTION : LEARN_QPTT
  4826.  
  4827.   PURPOSE  : Quickprop through time learning function
  4828.   RETURNS  : kernel error code
  4829.   NOTES    : Input Parameters:   1 : step_size
  4830.                                  2 : maximum step growth
  4831.                  3 : decay factor
  4832.                  4 : nhist
  4833.              Output Parameters:  1 : error of the network (sum of all cycles)
  4834.  
  4835.   UPDATE   : 06.11.1993 by Guenter Mamier
  4836. ******************************************************************************/
  4837. krui_err  LEARN_QPTT(int start_pattern, int end_pattern, 
  4838.              float *parameterInArray, int NoOfInParams, 
  4839.              float **parameterOutArray, int *NoOfOutParams)
  4840. {
  4841.     static float    OutParameter[1];    /* OutParameter[0] stores the
  4842.                        learning error  */
  4843.     int             i, ret_code, pattern_no, sub_pat_no, patterns;
  4844.     int             nhist;    /* number of steps back in time */
  4845.     register struct Unit *unit_ptr;
  4846.  
  4847.     if (NoOfUnits == 0)
  4848.     return (KRERR_NO_UNITS);/* No Units defined     */
  4849.     if (NoOfInParams < 1)    /* snns habit ? */
  4850.     return (KRERR_PARAMETERS);    /* Not enough input parameters  */
  4851.  
  4852.     *NoOfOutParams = 1;        /* One return value is available (the
  4853.                    learning error)  */
  4854.     *parameterOutArray = OutParameter;    /* set the output parameter reference */
  4855.     ret_code = KRERR_NO_ERROR;    /* reset return code  */
  4856.  
  4857.     if (NetModified || (TopoSortID != TOPOLOGIC_TYPE)) {
  4858.     /* Net has been modified or topologic array isn't initialized */
  4859.     /* any connected topology allowed */
  4860.     /* count the no. of I/O units and check the patterns  */
  4861.     ret_code = kr_IOCheck();
  4862.     if (ret_code < KRERR_NO_ERROR)
  4863.         return (ret_code);
  4864.  
  4865.     /* sort units by ''topologic type'', criterion is visibility
  4866.        (input,hidden,output), not topology */
  4867.     ret_code = kr_topoSort(TOPOLOGIC_TYPE);
  4868.  
  4869.     if ((ret_code != KRERR_NO_ERROR) && (ret_code != KRERR_DEAD_UNITS))
  4870.         return (ret_code);
  4871.     /* sites are not supported, check absence */
  4872.     FOR_ALL_UNITS(unit_ptr)
  4873.         if UNIT_HAS_SITES
  4874.         (unit_ptr)
  4875.         return (KRERR_SITES_NO_SUPPORT);
  4876.     NetModified = FALSE;
  4877.     }
  4878.     if (NetInitialize || LearnFuncHasChanged) {    /* Net has been modified or
  4879.                            initialized, clear weight
  4880.                            changes */
  4881.     ret_code = BPTT_clear_deltaw();
  4882.     if (ret_code != KRERR_NO_ERROR)
  4883.         return (ret_code);
  4884.     }
  4885.     NET_ERROR(OutParameter) = 0.0;    /* reset network error value  */
  4886.  
  4887.     NoOfLearnedPatterns = 0;    /* correct bits using threshold of 0.5 */
  4888.     nhist = LEARN_PARAM4(parameterInArray);
  4889.     if (nhist > MAX_BPTT_BACKSTEP)
  4890.     return (KRERR_NET_DEPTH);    /* actbuf and learning functions
  4891.                        support only MAX_BPTT_BACKSTEP net
  4892.                        copies */
  4893.  
  4894.  
  4895.     /* compute the necessary sub patterns */
  4896.  
  4897.     KernelErrorCode = kr_initSubPatternOrder(start_pattern,end_pattern);
  4898.     if(KernelErrorCode != KRERR_NO_ERROR)
  4899.     return (KernelErrorCode);
  4900.  
  4901.  
  4902.     patterns = 0;
  4903.     while(kr_getSubPatternByOrder(&pattern_no,&sub_pat_no)){
  4904.  
  4905.     /* FORWARD-BPTT */
  4906.     /* 1st parameter is the pattern number 2nd parameter is the number of
  4907.        steps back in time */
  4908.     BPTT_propagateNetForward(pattern_no,sub_pat_no,nhist); /*Forward pass */
  4909.  
  4910.     /* Backward propagation  */
  4911.     NET_ERROR(OutParameter)
  4912.         += BPTT_propagateNetBackward(pattern_no, sub_pat_no, nhist);
  4913.  
  4914.     patterns++;
  4915.     }
  4916.     MODI_quickprop(LEARN_PARAM1(parameterInArray) / patterns,
  4917.            LEARN_PARAM2(parameterInArray),
  4918.            LEARN_PARAM3(parameterInArray));
  4919.  
  4920.     return (ret_code);
  4921. }
  4922.  
  4923.  
  4924. /*****************************************************************************
  4925.  
  4926.   GROUP        : kohonen_learning
  4927.  
  4928.   PURPOSE      : learning algorithm for Kohonen Feature Map
  4929.   AUTHOR       : Marc Seemann
  4930.   DATE         : August 6 1992
  4931.   LAST CHANGE  : 07.02.1994 by Sven Doering
  4932.  
  4933.              Copyright (c) 1992-1994  Neuro Group, Univ. of Tuebingen, FRG
  4934.  
  4935. ******************************************************************************/
  4936.  
  4937.  
  4938. /*****************************************************************************
  4939.   FUNCTION : propagateNet_kohonen
  4940.  
  4941.   PURPOSE  : Propagate and train a pattern
  4942.   NOTES    :
  4943.   UPDATE   : 07.02 1994 by Sven Doering
  4944.  
  4945.              Copyright (c) 1992-1994  Neuro Group, Univ. of Tuebingen, FRG
  4946.  
  4947. ******************************************************************************/
  4948.  
  4949. static float propagateNet_kohonen(int pattern_no, int sub_pat_no, float height,
  4950.                   float radius, int sizehor)
  4951. {
  4952.     register struct Link *link_ptr;
  4953.     register struct Site *site_ptr;
  4954.     register struct Unit *unit_ptr;
  4955.     register struct Unit *winner_ptr;
  4956.     register Patterns in_pat, out_pat;
  4957.     register int    NoOfCompounds, sizever, verwin, horwin, hor, ver, helpver,
  4958.     helphor, range, i;
  4959.     float           maximum, sum_error, deviat, learn_error, sum;
  4960.     float           unit_ptr_net;
  4961.     register TopoPtrArray topo_ptr;
  4962.     float           adapt;
  4963.     int             winner, ret, current_no;
  4964.  
  4965.  
  4966.     /* calculate the activation and the output values         */
  4967.     /* of the input units (Input Layer)                       */
  4968.  
  4969.     NoOfCompounds = NoOfInputUnits;
  4970.     sizever = NoOfHiddenUnits / sizehor;
  4971.  
  4972.     sum = 0.0;
  4973.  
  4974.     /* calculate startaddress for input pattern array  */
  4975.     in_pat = kr_getSubPatData(pattern_no,sub_pat_no,INPUT,NULL);
  4976.  
  4977.     topo_ptr = topo_ptr_array;
  4978.  
  4979.     /* copy pattern into input unit's activation and calculate output of the
  4980.        input units */
  4981.     while ((unit_ptr = *++topo_ptr) != NULL) { /* topo_ptr points to the
  4982.                           unit stuctures (sorted by:
  4983.                           input-, hidden- and
  4984.                           output-units, separated
  4985.                           with NULL pointers) */
  4986.     sum += *in_pat * *in_pat;
  4987.  
  4988.     if (unit_ptr->out_func == OUT_IDENTITY)
  4989.         /* identity output function: there is no need to call the output
  4990.            function  */
  4991.         unit_ptr->Out.output = unit_ptr->act = *in_pat++;
  4992.     else
  4993.         /* no identity output function: calculate unit's output also  */
  4994.         unit_ptr->Out.output = 
  4995.         (*unit_ptr->out_func) (unit_ptr->act = *in_pat++);
  4996.     }
  4997.  
  4998.     if (sum != 0.0)
  4999.     /* normalize the inputvector */
  5000.     normalize_inputvector(sum);
  5001.  
  5002.     /* propagate Kohonen Layer  */
  5003.  
  5004.     /* calculate the activation and the output values */
  5005.     /* of the cmpetitive units (hidden layer) */
  5006.  
  5007.     /* winner is determined using the dot product */
  5008.  
  5009.  
  5010.     winner_ptr = NULL;
  5011.     maximum = -1.0e30;        /* contains the maximum of the activations */
  5012.     current_no = 0;
  5013.  
  5014.     /* propagate hidden units  */
  5015.     while ((unit_ptr = *++topo_ptr) != NULL) {    /* topo_ptr points to a
  5016.                            (topological sorted) unit
  5017.                            stucture */
  5018.     unit_ptr_net = 0.0;
  5019.     if (UNIT_HAS_DIRECT_INPUTS(unit_ptr)) {    /* the unit has direct links */
  5020.         FOR_ALL_LINKS(unit_ptr, link_ptr)
  5021.         unit_ptr_net += (link_ptr->weight * link_ptr->to->Out.output);
  5022.     } else {        /* the unit has sites  */
  5023.         FOR_ALL_SITES_AND_LINKS(unit_ptr, site_ptr, link_ptr)
  5024.         unit_ptr_net += (link_ptr->weight * link_ptr->to->Out.output);
  5025.     }
  5026.  
  5027.     if (maximum < unit_ptr_net) {    /* determine winner unit  */
  5028.         winner_ptr = unit_ptr;
  5029.         maximum = unit_ptr_net;
  5030.         winner = current_no;
  5031.     }
  5032.     current_no++;
  5033.     /* reset output and activation of hidden units  */
  5034.     unit_ptr->Out.output = unit_ptr->act = (FlintType) 0;
  5035.     }
  5036.  
  5037.     /* the competitive winner is chosen */
  5038.  
  5039.     winner_ptr->Out.output = winner_ptr->act = (FlintType) 1;
  5040.     winner_ptr->bias++;
  5041.     winner_ptr->value_a = (FlintType) (pattern_no + 1);
  5042.  
  5043.     /* store number of according pattern in winner unit */
  5044.  
  5045.     horwin = winner % sizehor;
  5046.     verwin = winner / sizehor;
  5047.  
  5048.  
  5049.     /***************************************************************/
  5050.     /* Train  the  SOM                                             */
  5051.  
  5052.     /* Only the weights of links that go to the winner and its     */
  5053.     /* neighbourhood are adjusted, the others remain the same.     */
  5054.     /* The incoming weights to the competitive units are adapted   */
  5055.     /* as follows:                                                 */
  5056.  
  5057.     /* weight(new) = weight(old) + adapt * (output - weight(old))  */
  5058.  
  5059.     /* where adapt is the learning rate (0 < adapt <= 1.0)         */
  5060.     /* and output is the value of the input unit vector            */
  5061.  
  5062.     /***************************************************************/
  5063.  
  5064.  
  5065.     for (ver = 0; ver < sizever; ver++)
  5066.     for (hor = 0; hor < sizehor; hor++)
  5067.         if ((hor < radius + horwin) &&
  5068.         (hor > horwin - radius) &&
  5069.         (ver < radius + verwin) &&
  5070.         (ver > verwin - radius)) {
  5071.         helpver = (float) ((ver - verwin) * (ver - verwin));
  5072.         helphor = (float) ((hor - horwin) * (hor - horwin));
  5073.         adapt = height * exp(-(helpver + helphor) / 
  5074.                      (float) (radius * radius));
  5075.  
  5076.         sum = 0.0;
  5077.         range = ver * sizehor + hor + 1 + NoOfCompounds;
  5078.  
  5079.         /* get unit pointer of unit in adaptation range */
  5080.         unit_ptr = kr_getUnitPtr(range);
  5081.         
  5082.         if(!IS_SPECIAL_UNIT(unit_ptr)){
  5083.             if (unit_ptr->flags & UFLAG_DLINKS) { /* the unit has  */
  5084.                               /* direct links  */
  5085.             FOR_ALL_LINKS(unit_ptr, link_ptr) {
  5086.                 deviat=link_ptr->to->Out.output - link_ptr->weight;
  5087.                 learn_error = adapt * deviat;
  5088.                 link_ptr->weight += learn_error;
  5089.                 /* this is needed for the normalization of the
  5090.                    weight_vector */
  5091.                 sum += link_ptr->weight * link_ptr->weight;
  5092.             }
  5093.             } else {    /* the winner unit has sites  */
  5094.             FOR_ALL_SITES_AND_LINKS(winner_ptr,site_ptr,link_ptr) {
  5095.                 deviat=link_ptr->to->Out.output - link_ptr->weight;
  5096.                 learn_error = adapt * deviat;
  5097.                 link_ptr->weight += learn_error;
  5098.                 /* this is needed for the normalization of the
  5099.                    weight_vector */
  5100.                 sum += link_ptr->weight * link_ptr->weight;
  5101.             }
  5102.             }
  5103.             if (sum != 0.0)
  5104.             normalize_weight(unit_ptr, sum);
  5105.         }
  5106.         }
  5107.     sum_error = 0.0;        /* 0.0 is chosen arbitrarily and serves no
  5108.                    purpose */
  5109.     return (sum_error);
  5110. }
  5111.  
  5112.  
  5113. /*****************************************************************************
  5114.   FUNCTION : initializeKohonenLearning
  5115.  
  5116.   PURPOSE  : initialize the SOM
  5117.   NOTES    :
  5118.   UPDATE   : 19.08.1993
  5119.  
  5120.              Copyright (c) 1992-1994  Neuro Group, Univ. of Tuebingen, FRG
  5121.  
  5122. ******************************************************************************/
  5123. static krui_err initializeKohonenLearning(void)
  5124. {
  5125.     register unsigned short flags;
  5126.     register struct Link *link_ptr;
  5127.     register struct Unit *unit_ptr;
  5128.     register struct Site *site_ptr;
  5129.  
  5130.     FOR_ALL_UNITS(unit_ptr) {
  5131.     flags = unit_ptr->flags;
  5132.  
  5133.     if ((flags & UFLAG_IN_USE) == UFLAG_IN_USE)    /* unit is in use  */
  5134.         unit_ptr->value_a = unit_ptr->bias = (FlintType) 0.0;
  5135.     }
  5136.     return (KRERR_NO_ERROR);
  5137. }
  5138.  
  5139.  
  5140.  
  5141. /*****************************************************************************
  5142.   FUNCTION : LEARN_kohonen
  5143.  
  5144.   PURPOSE  :  incorporates the body of the kohonen learning algorithm
  5145.   NOTES    :  the parameterInArray must contain 4 parameter
  5146.                       1) initial adaptation height
  5147.                       2) initial adaptation radius
  5148.                          3) multiplication factor
  5149.                      4) horizontal ize of the competitive (hidden) layer
  5150.  
  5151.   UPDATE   : july 13 1993
  5152. ******************************************************************************/
  5153. krui_err LEARN_kohonen(int start_pattern, int end_pattern,
  5154.                float parameterInArray[], int NoOfInParams,
  5155.                float **parameterOutArray, int *NoOfOutParams)
  5156. {
  5157.     static float    OutParameter[1];    /* OutParameter[0] stores the
  5158.                        learning error  */
  5159.     int             ret_code, i, pattern_no, sub_pat_no;
  5160.     register struct Unit *unit_ptr;
  5161.     register struct Link *link_ptr;
  5162.  
  5163.     if (NoOfUnits == 0)
  5164.     return (KRERR_NO_UNITS);/* No Units defined    */
  5165.     if (NoOfInParams < 5)    /* see Note  */
  5166.     return (KRERR_PARAMETERS);    /* Not enough input parameters  */
  5167.  
  5168.     *NoOfOutParams = 1;        /* one return value is available (the
  5169.                    learning error) */
  5170.     *parameterOutArray = OutParameter;    /* set output parameter reference  */
  5171.     ret_code = KRERR_NO_ERROR;    /* clear return code  */
  5172.  
  5173.  
  5174.     if (NetModified || (TopoSortID != TOPOLOGIC_TYPE)) {    
  5175.     /* Net has been modified or topologic array isn't initialized */
  5176.     /* count the no. of I/O units and check the patterns  */
  5177.     ret_code = kr_IOCheck();
  5178.     if (ret_code == KRERR_NO_OUTPUT_UNITS)
  5179.         ret_code = KRERR_NO_ERROR;
  5180.     if (ret_code < KRERR_NO_ERROR)
  5181.         return (ret_code);
  5182.  
  5183.     /* sort units by topology and by topologic type  */
  5184.     ret_code = kr_topoSort(TOPOLOGIC_TYPE);
  5185.     if (ret_code == KRERR_NO_OUTPUT_UNITS)
  5186.         ret_code = KRERR_NO_ERROR;
  5187.     if ((ret_code != KRERR_NO_ERROR) && (ret_code != KRERR_DEAD_UNITS))
  5188.         return (ret_code);
  5189.  
  5190.     NetModified = FALSE;
  5191.     }
  5192.     if (NetInitialize || LearnFuncHasChanged) {    /* Net has been modified or
  5193.                            initialized, initialize
  5194.                            kohonen now  */
  5195.     ret_code = initializeKohonenLearning();
  5196.     if (ret_code != KRERR_NO_ERROR)
  5197.         return (ret_code);
  5198.     }
  5199.     if ((int) LEARN_PARAM5(parameterInArray) == 0) {
  5200.     ret_code = KRERR_PARAMETERS;
  5201.     return (ret_code);
  5202.     }
  5203.     if ((LEARN_PARAM3(parameterInArray) > 1.0) ||
  5204.     (LEARN_PARAM3(parameterInArray) < 0.0)) {
  5205.     ret_code = KRERR_PARAMETERS;
  5206.     return (ret_code);
  5207.     }
  5208.     if ((LEARN_PARAM4(parameterInArray) > 1.0) ||
  5209.     (LEARN_PARAM4(parameterInArray) < 0.0)) {
  5210.     ret_code = KRERR_PARAMETERS;
  5211.     return (ret_code);
  5212.     }
  5213.  
  5214.  
  5215.     /* compute the necessary sub patterns */
  5216.  
  5217.     KernelErrorCode = kr_initSubPatternOrder(start_pattern,end_pattern);
  5218.     if(KernelErrorCode != KRERR_NO_ERROR)
  5219.     return (KernelErrorCode);
  5220.  
  5221.  
  5222.     NET_ERROR(OutParameter) = 0.0;    /* reset network error value  */
  5223.     while(kr_getSubPatternByOrder(&pattern_no,&sub_pat_no)){
  5224.  
  5225.     NoOfLearnedPatterns++;
  5226.     NET_ERROR(OutParameter) +=
  5227.         propagateNet_kohonen(pattern_no,sub_pat_no,
  5228.                  LEARN_PARAM1(parameterInArray),
  5229.                  LEARN_PARAM2(parameterInArray),
  5230.                  (int) LEARN_PARAM5(parameterInArray));
  5231.  
  5232.     LEARN_PARAM1(parameterInArray) *= LEARN_PARAM3(parameterInArray);
  5233.     LEARN_PARAM2(parameterInArray) *= LEARN_PARAM4(parameterInArray);
  5234.  
  5235.     }
  5236.     return (ret_code);
  5237. }
  5238.  
  5239.  
  5240. /*****************************************************************************
  5241.   FUNCTION : spanning_tree
  5242.  
  5243.   PURPOSE  : calculate the spanning tree of the kohonen feature map
  5244.   NOTES    : evaluating the learn function doesn't affect the net itself
  5245.  
  5246.   UPDATE   : july 13 1993
  5247. ******************************************************************************/
  5248. krui_err  spanning_tree(void)
  5249. {
  5250.     register TopoPtrArray topo_ptr;
  5251.     register struct Unit *unit_ptr;
  5252.     register struct Link *link_ptr;
  5253.     int             ret_code, i, n, pattern_no, sub_pat_no;
  5254.  
  5255.  
  5256.     if (NoOfUnits == 0)
  5257.     return (KRERR_NO_UNITS);/* No Units defined    */
  5258.  
  5259.     ret_code = KRERR_NO_ERROR;    /* clear return code  */
  5260.  
  5261.  
  5262.     if (NetModified || (TopoSortID != TOPOLOGIC_TYPE)) {    
  5263.     /* Net has been modified or topologic array isn't initialized */
  5264.     /* count the no. of I/O units and check the patterns  */
  5265.     ret_code = kr_IOCheck();
  5266.     if (ret_code == KRERR_NO_OUTPUT_UNITS)
  5267.         ret_code = KRERR_NO_ERROR;
  5268.     if (ret_code < KRERR_NO_ERROR)
  5269.         return (ret_code);
  5270.  
  5271.     /* sort units by topology and by topologic type  */
  5272.     ret_code = kr_topoSort(TOPOLOGIC_TYPE);
  5273.     if (ret_code == KRERR_NO_OUTPUT_UNITS)
  5274.         ret_code = KRERR_NO_ERROR;
  5275.     if ((ret_code != KRERR_NO_ERROR) && (ret_code != KRERR_DEAD_UNITS))
  5276.         return (ret_code);
  5277.  
  5278.     NetModified = FALSE;
  5279.     }
  5280.     if (NetInitialize || LearnFuncHasChanged) {    /* Net has been modified or
  5281.                            initialized, initialize
  5282.                            kohonen now  */
  5283.     ret_code = initializeKohonenLearning();
  5284.     if (ret_code != KRERR_NO_ERROR)
  5285.         return (ret_code);
  5286.     }
  5287.     topo_ptr = topo_ptr_array;
  5288.  
  5289.     while ((unit_ptr = *++topo_ptr) != NULL);
  5290.     /* topo_ptr points to the units' stucture (sorted by: input-, hidden- and
  5291.        output-units, separated by NULL pointers) */
  5292.  
  5293.     while ((unit_ptr = *++topo_ptr) != NULL)
  5294.     /* topo_ptr points to hidden_units */
  5295.     unit_ptr->value_a = 0;    /* the unit next to a pattern stores the
  5296.                    number of that pattern in value_a, at the
  5297.                    beginning initialized to 0 */
  5298.  
  5299.  
  5300.     n = 0;
  5301.     while(kr_getSubPatternByNo(&pattern_no,&sub_pat_no,n++)){
  5302.  
  5303.     /* To calculate the winning unit we call the  propagateNet_kohonen
  5304.        function, and treat the map as 1-dimensional array */
  5305.     propagateNet_kohonen(pattern_no, sub_pat_no, 0.0, 0.0, 1);
  5306.     }
  5307.  
  5308.     return (ret_code);
  5309.  
  5310. }/* spanning_tree */
  5311.  
  5312.  
  5313.  
  5314.  
  5315. /*****************************************************************************
  5316.  
  5317.   GROUP        : JORDAN / ELMAN networks 
  5318.  
  5319.   PURPOSE      : learning functions for JORDAN / ELMAN networks
  5320.   AUTHOR       : Tobias Soyez
  5321.   DATE         : 09.11.1993
  5322.   LAST CHANGE  : 09.11.1993
  5323.  
  5324.              Copyright (c) 1990-1994  SNNS Group, IPVR, Univ. Stuttgart, FRG
  5325.  
  5326.  
  5327. ******************************************************************************/
  5328.  
  5329.  
  5330. /*****************************************************************************
  5331.   FUNCTION : update_je_context_units
  5332.  
  5333.   PURPOSE  : synchronous update of context units
  5334.   NOTES    :
  5335.  
  5336.   UPDATE   :
  5337. ******************************************************************************/
  5338.  
  5339. static void update_je_context_units (int pattern_no, int sub_pat_no) 
  5340.  
  5341. {
  5342.     register TopoPtrArray   topo_ptr, topo_ptr_context ;
  5343.     register struct Unit   *unit_ptr ;
  5344.     register Patterns       out_pat  ;
  5345.     int size;
  5346.  
  5347.  
  5348.     out_pat = kr_getSubPatData(pattern_no,sub_pat_no,OUTPUT,&size);
  5349.     out_pat += size;
  5350.     
  5351.     topo_ptr_context = topo_ptr_array + (no_of_topo_units + 3) ;
  5352.  
  5353.  
  5354.     /* ----  store real output, force teaching output  ---- */
  5355.  
  5356.     topo_ptr = topo_ptr_context ;
  5357.  
  5358.     while ((unit_ptr = *--topo_ptr) != NULL)
  5359.     {
  5360.       unit_ptr->actbuf[0]  = unit_ptr->Out.output ;
  5361.       unit_ptr->Out.output = *--out_pat ;
  5362.     }
  5363.     
  5364.  
  5365.     /* ----  calculate new activation of context units ---- */
  5366.  
  5367.    topo_ptr = topo_ptr_context ;
  5368.  
  5369.     while ((unit_ptr = *++topo_ptr) != NULL)
  5370.     {
  5371.       unit_ptr->act = (*unit_ptr->act_func) (unit_ptr) ;
  5372.  
  5373.       if (unit_ptr->out_func == OUT_IDENTITY)
  5374.         unit_ptr->Out.output = unit_ptr->act ;
  5375.       else
  5376.         unit_ptr->Out.output = (*unit_ptr->out_func) (unit_ptr->act) ;
  5377.     }
  5378.  
  5379.     /* ----  restore real output  ---- */
  5380.  
  5381.     topo_ptr = topo_ptr_context ;
  5382.  
  5383.     while ((unit_ptr = *--topo_ptr) != NULL)
  5384.     {
  5385.       unit_ptr->Out.output = unit_ptr->actbuf[0] ;
  5386.     }
  5387. }
  5388.  
  5389.  
  5390. /*****************************************************************************
  5391.   FUNCTION : reset_je_context_units
  5392.  
  5393.   PURPOSE  : resets the context units 
  5394.   NOTES    :
  5395.  
  5396.   UPDATE   :
  5397. ******************************************************************************/
  5398.  
  5399. static void reset_je_context_units (void)
  5400.  
  5401. {
  5402.   register TopoPtrArray   topo_ptr ;
  5403.   register struct Unit   *unit_ptr ;
  5404.  
  5405.  
  5406.   topo_ptr = topo_ptr_array + (no_of_topo_units + 3) ;
  5407.   
  5408.   while ((unit_ptr = *++topo_ptr) != NULL)
  5409.   {
  5410.     unit_ptr->act = unit_ptr->i_act ;
  5411.  
  5412.     if (unit_ptr->out_func == OUT_IDENTITY)
  5413.       unit_ptr->Out.output = unit_ptr->act ;
  5414.     else
  5415.       unit_ptr->Out.output = (*unit_ptr->out_func) (unit_ptr->act) ;
  5416.   }
  5417. }
  5418.  
  5419.  
  5420. /*****************************************************************************
  5421.   FUNCTION : check_je_network
  5422.  
  5423.   PURPOSE  : checks the topology of a partial recurrent network
  5424.              (i.e. JORDAN and ELMAN networks)
  5425.   NOTES    :
  5426.  
  5427.   UPDATE   :
  5428. ******************************************************************************/
  5429. static krui_err check_je_network (void) 
  5430.  
  5431. {
  5432.     /*  check the topology of the network  */
  5433.     (void) kr_topoCheckJE () ;
  5434.     if (KernelErrorCode != KRERR_NO_ERROR) return (KernelErrorCode) ;
  5435.  
  5436.     /*    count the no. of I/O units and check the patterns  */
  5437.     if (kr_IOCheck() != KRERR_NO_ERROR) return (KernelErrorCode) ;
  5438.  
  5439.     /*    sort units by topology and by topologic type  */
  5440.     (void) kr_topoSort (TOPOLOGICAL_JE) ;
  5441.  
  5442.     if ((KernelErrorCode != KRERR_NO_ERROR) && 
  5443.         (KernelErrorCode != KRERR_DEAD_UNITS))
  5444.       return (KernelErrorCode) ;
  5445.  
  5446.     NetModified = FALSE;
  5447.     return (KRERR_NO_ERROR) ;
  5448. }
  5449.  
  5450.  
  5451.  
  5452. /*****************************************************************************
  5453.   FUNCTION : LEARN_JE_Backprop
  5454.  
  5455.   PURPOSE  : backpropagation learning function for JORDAN / ELMAN networks
  5456.   NOTES    : input parameters  :   1. learning parameter
  5457.                                    2. delta max 
  5458.              output parameters :   1. error of the network (sum of all cycles)
  5459.              return value      :   kernel error code
  5460.   UPDATE   :
  5461. ******************************************************************************/
  5462. krui_err  LEARN_JE_Backprop (int     start_pattern    , int  end_pattern ,
  5463.                              float  *parameterInArray , int  NoOfInParams, 
  5464.                              float **parameterOutArray, int *NoOfOutParams)
  5465.  
  5466. {
  5467.   static float  OutParameter[1] ; /* OutParameter[0] stores the */
  5468.                                   /* learning error             */
  5469.   int            n, pattern_no,sub_pat_no ;
  5470.   int           start, end;
  5471.  
  5472.  
  5473.   KernelErrorCode = KRERR_NO_ERROR;  /*  reset return code  */
  5474.  
  5475.   if (NoOfInParams < 2) return (KRERR_PARAMETERS) ;
  5476.  
  5477.   *NoOfOutParams     = 1            ; /* one return value is available      */
  5478.                                       /* (the learning error)               */
  5479.   *parameterOutArray = OutParameter ; /* set the output parameter reference */ 
  5480.   NET_ERROR (OutParameter) = 0.0    ; /* reset network error value          */
  5481.  
  5482.   if (NetModified || (TopoSortID != TOPOLOGICAL_JE))
  5483.   {
  5484.      KernelErrorCode = check_je_network () ;
  5485.      if (KernelErrorCode != KRERR_NO_ERROR) return (KernelErrorCode) ;
  5486.   }
  5487.  
  5488.   reset_je_context_units () ;
  5489.  
  5490.  
  5491.     /* compute the necessary sub patterns */
  5492.  
  5493.     KernelErrorCode = kr_initSubPatternOrder(start_pattern,end_pattern);
  5494.     if(KernelErrorCode != KRERR_NO_ERROR)
  5495.     return (KernelErrorCode);
  5496.  
  5497.     start = kr_AbsPosOfFirstSubPat(start_pattern);
  5498.     end   = kr_AbsPosOfFirstSubPat(end_pattern);
  5499.     end  += kr_NoOfSubPatPairs(end_pattern) - 1;
  5500.  
  5501.     for(n=start; n<=end; n++){
  5502.  
  5503.     kr_getSubPatternByNo(&pattern_no,&sub_pat_no,n);
  5504.  
  5505.     propagateNetForward (pattern_no,sub_pat_no) ;    
  5506.     NET_ERROR (OutParameter) +=
  5507.         propagateNetBackward2 (pattern_no,sub_pat_no, 
  5508.                    LEARN_PARAM1 (parameterInArray), 
  5509.                    LEARN_PARAM2 (parameterInArray)) ;
  5510.     update_je_context_units (pattern_no,sub_pat_no) ;
  5511.     }
  5512.  
  5513.   return (KernelErrorCode) ;
  5514. }
  5515.  
  5516.  
  5517. /*****************************************************************************
  5518.   FUNCTION : LEARN_JE_BackpropMomentum
  5519.  
  5520.   PURPOSE  : backpropagation with momentum term learning funcyion
  5521.              for JORDAN / ELMAN networks
  5522.   NOTES    : input parameters  :   1. learning parameter
  5523.                                    2. momentum factor
  5524.                                    3. flat spot elimination
  5525.                                    4. delta max
  5526.              output parameters :   1. error of the network (sum of all cycles)
  5527.              return value      :   kernel error code
  5528.   UPDATE   :
  5529. ******************************************************************************/
  5530. krui_err LEARN_JE_BackpropMomentum(int start_pattern, int end_pattern,
  5531.                    float *parameterInArray, int NoOfInParams, 
  5532.                    float **parameterOutArray, 
  5533.                    int *NoOfOutParams)
  5534.  
  5535. {
  5536.   static float  OutParameter[1] ; /* OutParameter[0] stores the */
  5537.                                   /* learning error             */
  5538.   int            n, pattern_no,sub_pat_no ;
  5539.   int           start, end;
  5540.  
  5541.   KernelErrorCode = KRERR_NO_ERROR;  /*  reset return code  */
  5542.  
  5543.   if (NoOfInParams < 2) return (KRERR_PARAMETERS) ;
  5544.  
  5545.   *NoOfOutParams     = 1            ; /* one return value is available      */
  5546.                                       /* (the learning error)               */
  5547.   *parameterOutArray = OutParameter ; /* set the output parameter reference */ 
  5548.   NET_ERROR (OutParameter) = 0.0    ; /* reset network error value          */
  5549.  
  5550.   if (NetModified || (TopoSortID != TOPOLOGICAL_JE))
  5551.   {
  5552.      KernelErrorCode = check_je_network () ;
  5553.      if (KernelErrorCode != KRERR_NO_ERROR) return (KernelErrorCode) ;
  5554.   }
  5555.  
  5556.   if (NetInitialize || LearnFuncHasChanged)
  5557.   {  /*  Net has been modified or initialized, initialize backprop now  */
  5558.     KernelErrorCode = initializeBackpropMomentum () ;
  5559.     if (KernelErrorCode != KRERR_NO_ERROR) return (KernelErrorCode) ;
  5560.   }
  5561.  
  5562.   reset_je_context_units () ;
  5563.  
  5564.  
  5565.   /* compute the necessary sub patterns */
  5566.  
  5567.   KernelErrorCode = kr_initSubPatternOrder(start_pattern,end_pattern);
  5568.   if(KernelErrorCode != KRERR_NO_ERROR)
  5569.       return (KernelErrorCode);
  5570.   
  5571.   start = kr_AbsPosOfFirstSubPat(start_pattern);
  5572.   end   = kr_AbsPosOfFirstSubPat(end_pattern);
  5573.   end  += kr_NoOfSubPatPairs(end_pattern) - 1;
  5574.  
  5575.   for(n=start; n<=end; n++){
  5576.  
  5577.       kr_getSubPatternByNo(&pattern_no,&sub_pat_no,n);
  5578.  
  5579.       propagateNetForward (pattern_no,sub_pat_no) ;    
  5580.       NET_ERROR (OutParameter) +=
  5581.       Backprop_momentum_FSE (pattern_no,sub_pat_no,
  5582.                  LEARN_PARAM1( parameterInArray ),
  5583.                  LEARN_PARAM2( parameterInArray ),
  5584.                  LEARN_PARAM3( parameterInArray ),
  5585.                  LEARN_PARAM4( parameterInArray )) ;
  5586.       update_je_context_units (pattern_no, sub_pat_no) ;
  5587.   }
  5588.  
  5589.   return (KernelErrorCode) ;
  5590. }
  5591.  
  5592.  
  5593. /*****************************************************************************
  5594.   FUNCTION : LEARN_JE_Quickprop
  5595.  
  5596.   PURPOSE  : quickprop learning function for JORDAN / ELMAN networks
  5597.   NOTES    : input parameters  :   1. learning parameter
  5598.                                    2. max. growth factor
  5599.                                    3. weight decay
  5600.                                    4. delta max 
  5601.              output parameters :   1. error of the network (sum of all cycles)
  5602.              return value      :   kernel error code
  5603.   UPDATE   :
  5604. ******************************************************************************/
  5605. krui_err  LEARN_JE_Quickprop (int     start_pattern    , int  end_pattern ,
  5606.                               float  *parameterInArray , int  NoOfInParams, 
  5607.                               float **parameterOutArray, int *NoOfOutParams)
  5608.  
  5609. {
  5610.   static float  OutParameter[1] ; /* OutParameter[0] stores the */
  5611.                                   /* learning error             */
  5612.   int            n,pattern_no,sub_pat_no ;
  5613.   int           start, end;
  5614.  
  5615.   KernelErrorCode = KRERR_NO_ERROR;  /*  reset return code  */
  5616.  
  5617.   if (NoOfInParams < 2) return (KRERR_PARAMETERS) ;
  5618.  
  5619.   *NoOfOutParams     = 1            ; /* one return value is available      */
  5620.                                       /* (the learning error)               */
  5621.   *parameterOutArray = OutParameter ; /* set the output parameter reference */ 
  5622.   NET_ERROR (OutParameter) = 0.0    ; /* reset network error value          */
  5623.  
  5624.   if (NetModified || (TopoSortID != TOPOLOGICAL_JE))
  5625.   {
  5626.      KernelErrorCode = check_je_network () ;
  5627.      if (KernelErrorCode != KRERR_NO_ERROR) return (KernelErrorCode) ;
  5628.   }
  5629.  
  5630.   if (NetInitialize || LearnFuncHasChanged)
  5631.   { 
  5632.     /*  Net has been modified or initialized, initialize quickprop now  */
  5633.     KernelErrorCode = initializeQuickprop () ;
  5634.     if (KernelErrorCode != KRERR_NO_ERROR)  return (KernelErrorCode) ;
  5635.   }
  5636.  
  5637.  
  5638.   reset_je_context_units () ;
  5639.  
  5640.  
  5641.  
  5642.   /* compute the necessary sub patterns */
  5643.  
  5644.   KernelErrorCode = kr_initSubPatternOrder(start_pattern,end_pattern);
  5645.   if(KernelErrorCode != KRERR_NO_ERROR)
  5646.     return (KernelErrorCode);
  5647.  
  5648.   start = kr_AbsPosOfFirstSubPat(start_pattern);
  5649.   end   = kr_AbsPosOfFirstSubPat(end_pattern);
  5650.   end  += kr_NoOfSubPatPairs(end_pattern) - 1;
  5651.  
  5652.   for(n=start; n<=end; n++){
  5653.  
  5654.       kr_getSubPatternByNo(&pattern_no,&sub_pat_no,n);
  5655.  
  5656.       propagateNetForward (pattern_no,sub_pat_no) ;    
  5657.       NET_ERROR(OutParameter) +=
  5658.       propagateNetBackwardQuickprop (pattern_no,sub_pat_no,
  5659.                      LEARN_PARAM4 (parameterInArray)) ;
  5660.       update_je_context_units (pattern_no,sub_pat_no) ;
  5661.   }
  5662.  
  5663.   MODI_quickprop (LEARN_PARAM1 (parameterInArray),
  5664.                   LEARN_PARAM2 (parameterInArray),
  5665.                   LEARN_PARAM3 (parameterInArray)) ;
  5666.  
  5667.   return (KernelErrorCode) ;
  5668. }
  5669.  
  5670.  
  5671.  
  5672. /*****************************************************************************
  5673.   FUNCTION : LEARN_JE_Rprop
  5674.  
  5675.   PURPOSE  : rprop learning function for JORDAN / ELMAN networks
  5676.   NOTES    : input parameters  :   1. delta 0
  5677.                                    2. delta max 
  5678.              output parameters :   1. error of the network (sum of all cycles)
  5679.              return value      :   kernel error code
  5680.   UPDATE   :
  5681. ******************************************************************************/
  5682. krui_err  LEARN_JE_Rprop    (int     start_pattern    , int  end_pattern ,
  5683.                              float  *parameterInArray , int  NoOfInParams, 
  5684.                              float **parameterOutArray, int *NoOfOutParams)
  5685.  
  5686. {
  5687.   static float  OutParameter[1] ; /* OutParameter[0] stores the */
  5688.                                   /* learning error             */
  5689.   int            pattern_no,sub_pat_no ;
  5690.   int           i, n, ret_code, blocksize ;
  5691.   float         maxeps, update_value ;
  5692.   int           start, end;
  5693.  
  5694.  
  5695.   if (NoOfInParams < 2) return (KRERR_PARAMETERS) ;
  5696.  
  5697.   if (( update_value = LEARN_PARAM1 (parameterInArray)) == 0.0) 
  5698.     update_value = RPROP_DEFAULT_UPDATE_VALUE;
  5699.   if ((maxeps = LEARN_PARAM2 (parameterInArray)) == 0.0) 
  5700.     maxeps = RPROP_MAXEPS;
  5701.   if (update_value > maxeps) update_value = maxeps;
  5702.  
  5703.  
  5704.   KernelErrorCode = ret_code = KRERR_NO_ERROR;  /*  reset return code  */
  5705.  
  5706.  
  5707.   *NoOfOutParams     = 1            ; /* one return value is available      */
  5708.                                       /* (the learning error)               */
  5709.   *parameterOutArray = OutParameter ; /* set the output parameter reference */ 
  5710.   NET_ERROR (OutParameter) = 0.0    ; /* reset network error value          */
  5711.  
  5712.   if (NetModified || (TopoSortID != TOPOLOGICAL_JE))
  5713.   {
  5714.      KernelErrorCode = check_je_network () ;
  5715.      if (KernelErrorCode != KRERR_NO_ERROR) return (KernelErrorCode) ;
  5716.   }
  5717.  
  5718.   if (NetInitialize || LearnFuncHasChanged)
  5719.   {  /*  Net has been modified or initialized, initialize RPROP */
  5720.     ret_code = initializeRprop (update_value) ;
  5721.     if (ret_code != KRERR_NO_ERROR)  return (ret_code) ;
  5722.   }
  5723.  
  5724.   /* DEFAULTS: */
  5725.   if ((blocksize = LEARN_PARAM3 (parameterInArray)) == 0)
  5726.     blocksize = end_pattern;
  5727.  
  5728.   reset_je_context_units () ;
  5729.  
  5730.  
  5731.   /* compute the necessary sub patterns */
  5732.  
  5733.   KernelErrorCode = kr_initSubPatternOrder(start_pattern,blocksize);
  5734.   if(KernelErrorCode != KRERR_NO_ERROR)
  5735.       return (KernelErrorCode);
  5736.  
  5737.   start = kr_AbsPosOfFirstSubPat(start_pattern);
  5738.   end   = kr_AbsPosOfFirstSubPat(end_pattern);
  5739.   end  += kr_NoOfSubPatPairs(end_pattern) - 1;
  5740.  
  5741.   for(n=start; n<=end; n++){
  5742.  
  5743.       kr_getSubPatternByNo(&pattern_no,&sub_pat_no,n);
  5744.  
  5745.       propagateNetForward (pattern_no,sub_pat_no) ;    
  5746.       NET_ERROR (OutParameter) +=
  5747.       propagateNetBackwardRprop (pattern_no,sub_pat_no) ;
  5748.       update_je_context_units (pattern_no,sub_pat_no) ;
  5749.   }
  5750.   MODI_rprop (maxeps) ;
  5751.   return (KernelErrorCode) ;
  5752. }
  5753.  
  5754.  
  5755.  
  5756. /*****************************************************************************
  5757.  
  5758.   GROUP        : Functions for autoassoziative memory networks
  5759.  
  5760.   PURPOSE      : Implement autoassoziative memory networks, including learning 
  5761.                  functions for Rummelhart & McClelland's Delta Rule and Hebbian
  5762.          learning
  5763.   AUTHOR       : Jamie DeCoster
  5764.   CHANGES BY   : Guenter Mamier
  5765.   DATE         : 08.02.1994
  5766.   LAST CHANGE  : 09.03.1994
  5767.  
  5768.              Copyright (c) 1994  Jamie DeCoster, Purdue University, USA
  5769.  
  5770. ******************************************************************************/
  5771.  
  5772. /*****************************************************************************
  5773.   FUNCTION : RM_propagate
  5774.  
  5775.   PURPOSE  : forward propagation for Rummelhart & McClelland's Delta Rule
  5776.   NOTES    : 
  5777.  
  5778.   UPDATE   : 17.02.1994
  5779. ******************************************************************************/
  5780. static void RM_propagate (int pattern_no, int sub_pat_no, float prop_step)
  5781. {
  5782.  
  5783.     int t;
  5784.     register struct Unit   *unit_ptr;
  5785.     register Patterns      in_pat;
  5786.     register TopoPtrArray  topo_ptr;
  5787.  
  5788.  
  5789.     /*  calculate startaddress for input pattern array  */
  5790.     in_pat = kr_getSubPatData(pattern_no,sub_pat_no,INPUT,NULL);
  5791.     if(in_pat == NULL){
  5792.     KernelErrorCode = KRERR_NP_NO_SUCH_PATTERN;
  5793.     return;
  5794.     }
  5795.     
  5796.     topo_ptr = topo_ptr_array;
  5797.  
  5798.     /*  copy pattern into input unit's activation and calculate output of the 
  5799.     input units */
  5800.     while ((unit_ptr = *++topo_ptr) != NULL){
  5801.  
  5802.     /*  topo_ptr points to a (topological sorted) unit stucture  */
  5803.     if (unit_ptr->out_func == OUT_IDENTITY)
  5804.         /*  identity output function: don't call the output function  */
  5805.         unit_ptr->Out.output = unit_ptr->act = *in_pat++;
  5806.     else
  5807.         /*  no identity output function: calculate unit's output also  */
  5808.         unit_ptr->Out.output = 
  5809.         (*unit_ptr->out_func) (unit_ptr->act = *in_pat++);
  5810.     }
  5811.  
  5812.     for (t=0; t < prop_step; ++t){ 
  5813.  
  5814.     FOR_ALL_UNITS( unit_ptr )
  5815.         if UNIT_IN_USE( unit_ptr ){
  5816.  
  5817.         /* update unit activations first  */
  5818.         if ( !IS_INPUT_UNIT( unit_ptr)) 
  5819.             /*  unit isn't an input unit and is in use and enabled  */
  5820.             unit_ptr->act = (*unit_ptr->act_func) (unit_ptr);
  5821.  
  5822.         /* update unit outputs  */
  5823.         if (unit_ptr->out_func == OUT_IDENTITY)
  5824.             /*  identity output function: don't call output function  */
  5825.             unit_ptr->Out.output = unit_ptr->act;
  5826.         else
  5827.             /*  calculate unit's output also  */
  5828.             unit_ptr->Out.output = (*unit_ptr->out_func)(unit_ptr->act);
  5829.         }
  5830.     }
  5831.  
  5832. }
  5833.  
  5834.  
  5835. /*****************************************************************************
  5836.   FUNCTION : RM_learn
  5837.  
  5838.   PURPOSE  : backward propagation for Rummelhart & McClelland's Delta Rule
  5839.   NOTES    : 
  5840.  
  5841.   UPDATE   : 11.02.1994
  5842. ******************************************************************************/
  5843. static void RM_learn(float learn_parameter)
  5844. {
  5845.     register struct Link *link_ptr;
  5846.     register struct Site *site_ptr;
  5847.     register struct Unit *unit_ptr;
  5848.     float ex_in, in_in, error, eta;
  5849.  
  5850.     eta = learn_parameter;
  5851.  
  5852.     FOR_ALL_UNITS (unit_ptr)
  5853.     if (!IS_INPUT_UNIT (unit_ptr)){
  5854.         /* World units don't learn so their inputs are not examined */
  5855.  
  5856.         in_in = 0;
  5857.  
  5858.         FOR_ALL_LINKS (unit_ptr, link_ptr)
  5859.         if (IS_INPUT_UNIT (link_ptr->to))
  5860.             /* Determine the input from the world unit */
  5861.             ex_in = link_ptr->to->act * link_ptr->weight;
  5862.         else
  5863.             /* Determine the input from the network */
  5864.             in_in += link_ptr->to->act * link_ptr->weight; 
  5865.  
  5866.         /* Error defined as the difference between the world input and 
  5867.            the input from the net */ 
  5868.         error = ex_in - in_in; 
  5869.  
  5870.         /* Modify the weights */ 
  5871.         if (UNIT_HAS_DIRECT_INPUTS (unit_ptr)){
  5872.         FOR_ALL_LINKS (unit_ptr, link_ptr)
  5873.             if (!IS_INPUT_UNIT (link_ptr->to))  
  5874.             /* The link between a world unit and its corresponding 
  5875.                learning unit is always 1 */
  5876.             link_ptr->weight += link_ptr->to->act * eta * error;
  5877.         }else{
  5878.         FOR_ALL_SITES_AND_LINKS (unit_ptr, site_ptr, link_ptr)
  5879.             if (!IS_INPUT_UNIT (link_ptr->to))
  5880.             link_ptr->weight += link_ptr->to->act * eta * error;
  5881.         }
  5882.     }
  5883. }
  5884.  
  5885.  
  5886.  
  5887. /*****************************************************************************
  5888.   FUNCTION : LEARN_RM_delta 
  5889.  
  5890.   PURPOSE  : McClelland & Rumelhart's learning rule
  5891.                       Input parameter:   1: learning parameter
  5892.                                  2: no. of propagation steps
  5893.               Output parameter:  1:  Learning error
  5894.   NOTES    : 
  5895.  
  5896.   UPDATE   : 11.02.1994
  5897. ******************************************************************************/
  5898. krui_err LEARN_RM_delta (int start_pattern, int end_pattern,
  5899.              float *parameterInArray, int NoOfInParams, 
  5900.              float **parameterOutArray, int *NoOfOutParams)
  5901. {
  5902.  
  5903.     static float OutParameter [1];
  5904.     int i, j, pattern_no,sub_pat_no;
  5905.     int no_of_layers;
  5906.     float Learn_p;
  5907.     float prop_step;
  5908.     register struct Unit *unit_ptr;
  5909.     register Patterns in_pat;
  5910.  
  5911.     KernelErrorCode = KRERR_NO_ERROR;
  5912.  
  5913.     /* Checking for learning parameter */
  5914.     if (NoOfInParams < 2){  
  5915.     KernelErrorCode = KRERR_PARAMETERS;
  5916.     return (KernelErrorCode);
  5917.     }
  5918.  
  5919.     Learn_p = LEARN_PARAM1 (parameterInArray);
  5920.     prop_step = LEARN_PARAM2 (parameterInArray);
  5921.     if (prop_step == 0){  
  5922.     KernelErrorCode = KRERR_PARAMETERS;
  5923.     return (KernelErrorCode);
  5924.     }
  5925.  
  5926.     *NoOfOutParams = 1; /* Out Parameter = Learning error */
  5927.     *parameterOutArray = OutParameter;
  5928.  
  5929.     (void) kr_topoSort (TOPOLOGIC_TYPE);
  5930.  
  5931.     /* compute the necessary sub patterns */
  5932.  
  5933.     KernelErrorCode = kr_initSubPatternOrder(start_pattern,end_pattern);
  5934.     if(KernelErrorCode != KRERR_NO_ERROR)
  5935.     return (KernelErrorCode);
  5936.  
  5937.  
  5938.     /* reset network error value  */
  5939.     NET_ERROR (OutParameter) = 0.0;
  5940.  
  5941.     /* Determine order of pattern presentation */
  5942.     while(kr_getSubPatternByOrder(&pattern_no,&sub_pat_no)){
  5943.  
  5944.     /* Propagate the pattern through the network */
  5945.     RM_propagate (pattern_no,sub_pat_no,prop_step);        
  5946.  
  5947.     /* Update links */ 
  5948.     RM_learn (Learn_p);
  5949.  
  5950.     /* Compute network error */ 
  5951.     NET_ERROR (OutParameter) += Hebb_error(prop_step); 
  5952.     }
  5953.  
  5954.     return (KernelErrorCode);
  5955. } 
  5956.  
  5957.  
  5958. /*****************************************************************************
  5959.   FUNCTION : Hebb_error
  5960.  
  5961.   PURPOSE  : Compute the error of the network for the Hebbian learning rule
  5962.   NOTES    : 
  5963.  
  5964.   UPDATE   : 09.03.1994
  5965. ******************************************************************************/
  5966. static float Hebb_error(int NoOfTimes)
  5967. {
  5968.  
  5969.     struct Unit *unit_ptr;
  5970.     struct Link *link_ptr;
  5971.     float error, sum_error, ex_in;
  5972.     int t;
  5973.  
  5974.  
  5975.     /* update unit activations first  */
  5976.     for(t=0; t < NoOfTimes; ++t){ 
  5977.     FOR_ALL_UNITS( unit_ptr )
  5978.         if ( !IS_INPUT_UNIT( unit_ptr)) 
  5979.         if UNIT_IN_USE( unit_ptr )
  5980.             /*  unit isn't an input unit and is in use and enabled  */
  5981.             unit_ptr->act = (*unit_ptr->act_func) (unit_ptr);
  5982.  
  5983.     /* update unit outputs */
  5984.     FOR_ALL_UNITS( unit_ptr )
  5985.         if UNIT_IN_USE( unit_ptr )
  5986.         if (unit_ptr->out_func == OUT_IDENTITY)
  5987.             /* there is no need to call the output function  */
  5988.             unit_ptr->Out.output = unit_ptr->act;
  5989.         else
  5990.             /* calculate unit's output also  */
  5991.             unit_ptr->Out.output = (*unit_ptr->out_func)(unit_ptr->act);
  5992.     }
  5993.  
  5994.  
  5995.     /* calculate the error defined as the difference between the internal
  5996.        and external inputs */
  5997.  
  5998.     sum_error = 0.0;
  5999.  
  6000.     FOR_ALL_UNITS (unit_ptr){
  6001.     FOR_ALL_LINKS (unit_ptr, link_ptr)
  6002.         if (IS_INPUT_UNIT (link_ptr->to)){
  6003.         ex_in = link_ptr->to->act;
  6004.         error = ex_in - unit_ptr->act;
  6005.         }
  6006.     sum_error += error * error;
  6007.     }
  6008.     return (sum_error);
  6009. }
  6010.  
  6011.  
  6012.  
  6013. /*****************************************************************************
  6014.   FUNCTION : LEARN_Hebb 
  6015.  
  6016.   PURPOSE  : Hebbian learning rule
  6017.                       Input parameter:   1: learning parameter
  6018.                                  2: Maximum absolute weight strength
  6019.               Output parameter:  1: Network error
  6020.   NOTES    : 
  6021.  
  6022.   UPDATE   : 09.03.1994
  6023. ******************************************************************************/
  6024. krui_err LEARN_HEBB (int start_pattern, int end_pattern,
  6025.              float *parameterInArray, int NoOfInParams, 
  6026.              float **parameterOutArray, int *NoOfOutParams)
  6027. {
  6028.     static float OutParameter [1];
  6029.     int i, pattern_no, sub_pat_no;
  6030.     int NoOfTimes;
  6031.     float Learn_p, Weight_MAX;
  6032.     register struct Unit *unit_ptr;
  6033.     register struct Link *link_ptr;
  6034.     register struct Site *site_ptr;
  6035.     register Patterns in_pat;
  6036.     register TopoPtrArray topo_ptr;
  6037.  
  6038.  
  6039.     KernelErrorCode = KRERR_NO_ERROR;
  6040.  
  6041.     if (NoOfInParams < 3){  /* Checking for learning parameter */
  6042.     KernelErrorCode = KRERR_PARAMETERS;
  6043.     return (KernelErrorCode);
  6044.     }
  6045.  
  6046.     *NoOfOutParams = 1;  /* Out Parameter = Learning error */
  6047.     *parameterOutArray = OutParameter;
  6048.  
  6049.     Learn_p    = LEARN_PARAM1 (parameterInArray);
  6050.     Weight_MAX = LEARN_PARAM2 (parameterInArray);
  6051.     NoOfTimes  = (int)LEARN_PARAM3 (parameterInArray);
  6052.  
  6053.     if (NoOfTimes == 0){  /* Checking for learning parameter */
  6054.     KernelErrorCode = KRERR_PARAMETERS;
  6055.     return (KernelErrorCode);
  6056.     }
  6057.     
  6058.     kr_topoSort (TOPOLOGIC_TYPE);
  6059.  
  6060.     /* compute the necessary sub patterns */
  6061.  
  6062.     KernelErrorCode = kr_initSubPatternOrder(start_pattern,end_pattern);
  6063.     if(KernelErrorCode != KRERR_NO_ERROR)
  6064.         return (KernelErrorCode);
  6065.  
  6066.  
  6067.     /* reset network error value  */
  6068.     NET_ERROR (OutParameter) = 0.0;
  6069.  
  6070.     /* Determine order of pattern presentation */
  6071.     while(kr_getSubPatternByOrder(&pattern_no,&sub_pat_no)){
  6072.   
  6073.     /* calculate startaddress for input pattern array */
  6074.     in_pat = kr_getSubPatData(pattern_no,sub_pat_no,INPUT,NULL);
  6075.  
  6076.     topo_ptr = topo_ptr_array;
  6077.  
  6078.     /* copy pattern into input units  and calculate their output */
  6079.     while ((unit_ptr = *++topo_ptr) != NULL){
  6080.         /* topo_ptr points to a unit structure (input units first) */
  6081.         if (unit_ptr->out_func == OUT_IDENTITY)
  6082.         /* identity output function */
  6083.         unit_ptr->Out.output = unit_ptr->act = *in_pat++;
  6084.         else
  6085.         /* calculate unit's output */
  6086.         unit_ptr->Out.output = 
  6087.             (*unit_ptr->out_func) (unit_ptr->act = *in_pat++);
  6088.     }
  6089.  
  6090.     /* copy pattern from the world units to the learning units */
  6091.     FOR_ALL_UNITS (unit_ptr)
  6092.         FOR_ALL_LINKS (unit_ptr, link_ptr)
  6093.         if (IS_INPUT_UNIT (link_ptr->to))
  6094.             unit_ptr->act = link_ptr->to->act;
  6095.  
  6096.     /* Network has the same structure as the RM_delta autoassociative 
  6097.        network. Here we update the learning unit links. */
  6098.     FOR_ALL_UNITS (unit_ptr)
  6099.         if (!IS_INPUT_UNIT (unit_ptr)){
  6100.  
  6101.         /* Update the links */
  6102.         if (UNIT_HAS_DIRECT_INPUTS (unit_ptr)){
  6103.             FOR_ALL_LINKS (unit_ptr, link_ptr)
  6104.             if (!IS_INPUT_UNIT (link_ptr->to)){
  6105.                 /* Only change learning links */
  6106.                 link_ptr->weight += 
  6107.                 Learn_p * unit_ptr->act * (link_ptr->to->act);
  6108.                 if (link_ptr->weight > Weight_MAX)
  6109.                 link_ptr->weight = Weight_MAX;
  6110.                 if (link_ptr->weight < -Weight_MAX)
  6111.                 link_ptr->weight = -Weight_MAX;
  6112.             }
  6113.         }else{
  6114.             FOR_ALL_SITES_AND_LINKS (unit_ptr, site_ptr, link_ptr)
  6115.             if (!IS_INPUT_UNIT (link_ptr->to)){
  6116.                 link_ptr->weight += 
  6117.                 Learn_p * unit_ptr->act * (link_ptr->to->act);
  6118.                 if (link_ptr->weight > Weight_MAX)
  6119.                 link_ptr->weight = Weight_MAX;
  6120.                 if (link_ptr->weight < -Weight_MAX)
  6121.                 link_ptr->weight = -Weight_MAX;
  6122.             }
  6123.         }
  6124.         }
  6125.  
  6126.     NET_ERROR (OutParameter) += Hebb_error (NoOfTimes); 
  6127.     }
  6128.     return (KernelErrorCode);
  6129. }
  6130.  
  6131.